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TOOLS  FOR  SIMPLIFYING  PROOFS  OF  PROPERTIES  OF  TIMED  AUTOMATA: 
THE  TAME  TEMPLATE,  THEORIES,  AND  STRATEGIES 


1.  Introduction. 

TAME  is  a  high-level  PVS  interface  that  is  intended  to  provide  automated  support  to  simplify  speci¬ 
fying  and  reasoning  about  Lynch-Vaandrager  (LV)  timed  automata  [LV_91,HL_94]  with  PVS.  TAME  is 
based  upon  a  specification  template  for  timed  automata,  a  set  of  standard  theories,  and  a  set  of  standard 
PVS  strategies.  There  are  two  categories  of  TAME  strategies:  generic  strategies  and  local  strategies. 
Local  strategies  are  generated  from  a  template  instantiation,  and  are  therefore  different  in  detail  for  each 
particular  timed  automaton.  Similarly,  there  are  two  categories  of  standard  TAME  theories:  the  generic 
theories  and  local  theories,  where  the  local  theories  are  generated  from  a  given  template  instantiation. 

TAME  has  been  previously  described  in  several  papers,  including  [AH_96a],  [AH_96b],  [AH_97a], 
[AH_97b],  [AHS_98],  and  [AH_98].  The  last  documents  in  detail  the  state  of  TAME  at  the  time 
[AH_96a]  was  written  and  summarizes  more  recent  developments.  Perhaps  the  most  significant  of  these 
developments  is  the  design  of  a  generic  strategy  AUTO  JNDUCT  (for  “automaton  induction”)  that  does 
the  major  initial  work  in  the  induction  proof  of  a  state  invariant.  AUTOJNDUCT  and  several  other 
TAME  strategies  that  used  not  to  be  application-independent  are  so  now,  being  in  effect  “parameterized” 
by  the  local  strategies  and  local  theories.  TAME  also  now  supports  reasoning  about  I/O  automata 
[LT__89]  and  SCR  automata  (see  [AHS_98]).  This  report  documents  in  detail  the  current  state  of  TAME 
support  for  reasoning  about  LV  timed  automata  and  I/O  automata. 

Section  2  of  this  report  documents  the  TAME  strategies  from  the  user’s  point  of  view.  Appendix  1 
contains  the  TAME  timed  automaton  template.  Appendix  2  contains  the  generic  theories,  with  the  excep¬ 
tion  of  the  theory  atexecs,  which  supports  reasoning  about  admissible  timed  executions  of  timed  auto¬ 
mata,  and  which  is  documented  in  [AH_98].  Appendix  3  contains  the  code  of  the  current  TAME  stra¬ 
tegies.  Finally,  Appendix  4  contains  as  an  example  the  template  instantiation,  local  theories,  and  local 
strategies  for  the  Steam  Boiler  Controller  studied  in  [AH_97a]. 

2.  TAME  Strategies  for  the  TAME  User. 

(APPLY^GENERAL_PRECOND) 

Effect:  Causes  the  general  precondition  for  the  action  of  an  induction  branch  to  be  expanded. 

Use:  Sometimes  helpful  for  timed  automata;  irrelevant  for  untimed  I/O  automata. 
(APPLY_IND_HYP  <argl>  ...  <argn>) 

Effect:  Applies  the  inductive  hypothesis  to  the  arguments. 

Use:  Needed  when  a  universally  quantified  formula  is  being  proved  by  induction,  and  an  instantia¬ 
tion  of  the  inductive  hypothesis  other  than  the  default  is  required  in  an  induction  branch  of  the 
proof.  (The  default  instantiation  is  the  list  of  skolem  constants  that  is  automatically  generated  for 
the  inductive  conclusion  of  the  particular  proof  branch.) 

(APPLY_INV_LEMMA  <inv-name>  [<state>]  [<argl>  ...  <argn  >]) 

Effect:  Applies  the  invariant  lemma  lemma_<inv-name>  to  the  state  <state>,  if  present,  and  the 
argument  list.  If  <state>  is  omitted,  then  the  state  is  assumed  to  be  the  state  named  “prestate”, 
which  is  the  standard  name  for  the  prestate  of  the  transition  in  the  induction  step  of  any  induction 
proof,  the  initial  state  in  the  base  case,  and  the  generic  state  in  a  direct  proof.  The  resulting  formula 
or  formulas  are  labeled  “lemma_<inv-name>”. 

Use:  Needed  in  proving  invariant  lemmas  that  would  require  strengthening  to  be  inductive.  Also 
usually  needed  in  direct  (non-induction)  proofs. 

Manuscript  approved  January  8,  1999. 
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(APPLY_LEMMA  <lemma-name>  [<arg1>  ...  <arg/i  >]) 

Effect:  Applies  the  lemma  <lemma-name>  to  the  arguments.  The  resulting  formula  or  formulas 
are  labeled  “<lemma-name>”. 

Use:  Sometimes  needed  in  applying  lemmas  about  the  data  types  involved  in  the  automaton  state  to 
state  variables. 

(APPLY_SPECIFIC_PRECOND) 

Effect:  Causes  the  specific  precondition  for  the  action  of  an  induction  branch  to  be  expanded, 
and,  if  the  precondition  is  a  conjunction,  causes  the  conjuncts  in  the  precondition  to  be  separated 
and  given  secondary  individual  labels  as  “specific-precondition_part_r’,  ...  ,  "specific- 
precondition_part_n”,  according  to  their  position  in  the  conjunction. 

Use:  Needed  when  the  truth  of  the  induction  step  corresponding  to  an  action  depends  on  the 
precondition  of  the  action. 

(AUTOJNDUCT) 

Effect:  Causes  the  proof  of  a  formula  of  the  form 

(* )  (FORALL (s  '.states  ):reachable  (s)  =>  lnv_<invname  >(s )) 

to  be  split  into  branches  corresponding  to  the  base  case  and  each  action  case  of  an  induction  proof. 
When  Inv_<invname>  expands  to  a  universally  quantified  formula,  automatically  skolemizes  the 
inductive  conclusion,  and  instantiates  the  inductive  hypothesis  with  the  skolem  constants. 

Labels  parts  of  the  base  case  as  “prestate-definition”  and  “conclusion”;  when  the  conclusion  is  a 
disjunction,  the  disjuncts  are  separated,  and  given  secondary  labels  as  “conclusion_part_l”,  ...  , 
“conclusion_part_n”,  in  the  order  in  which  they  appear  in  the  disjunction.  (Implications  are  treated 
as  disjunctions.) 

Labels  parts  of  each  inductive  case  as  “prestate-reachable”,  “poststate-reachable”,  “general- 
precondition”,  “specific-precondition”,  “OKstate?”,  “inductive-hypothesis”,  and  “inductive- 
conclusion”.  When  the  inductive  hypothesis  is  a  conjunction  or  the  inductive  conclusion  is  a  dis¬ 
junction,  the  parts  are  separated  and,  in  analogy  with  “conclusion”  in  the  base  case,  given  secon¬ 
dary  individual  labels  as  “..._partl”  through  “..._part/i  ”.  (A  formula  A  IFF  B  is  treated  as  the 
conjunction  A  =>B  AND  B  =>A  .) 

Each  proof  branch  is  tested  to  see  if  it  can  be  proved  with  some  simple  propositional  reasoning  and 
the  application  of  standard  rewrites  and  decision  procedures.  If  the  proof  fails,  the  branch  is  unaf¬ 
fected.  As  a  result,  only  the  “nontrivial”  proof  branches  are  returned  to  the  user  for  further  interac¬ 
tive  proof. 

Comments  are  printed  at  the  beginning  of  each  proof  branch  in  the  saved  proof  indicating  either  that 
it  corresponds  to  the  base  case  or  that  is  the  (induction)  branch  corresponding  to  some  particular 
action. 

The  following  naming  conventions  are  followed;  In  the  base  case,  the  initial  state  is  called  “pre¬ 
state”.  In  every  induction  step,  the  prestate  is  called  “prestate”,  and  the  poststate  is  called  “post¬ 
state”.  When  an  action  has  parameters  <param_l>,  ...  ,  <param_m>,  these  are  replaced  in  the 
corresponding  action  case  by  the  skolem  constants  “<param_l  >_action”,  ...  , 
“<param_m>_action”.  When  the  invariant  is  univer.sally  quantified  over  variables  <name_l>, ... , 
<name_n>,  the  inductive  conclusion  is  skolemized  with  the  skolem  constants 
“<name_l>_theorem”,  ...  ,  “<name_n>_theorem”,  and  the  inductive  hypothesis  is  instantiated 
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with  these  skolem  constants.  The  strategy  APPLY_IND_HYP  can  be  used  if  a  different  instantia¬ 
tion  of  the  inductive  hypothesis  is  needed. 

Use:  Should  be  be  applied  only  as  the  first  step  in  the  proof  of  a  formula  of  the  form  (*).  Is  the 
appropriate  first  step  in  a  proof  by  induction  (as  opposed  to  a  proof  that  uses  direct  deduction  from 
other  invariant  lemmas).  Sometimes  is  the  only  step  needed  in  an  induction  proof. 

(CANCEL.FORMULAS) 

Effect:  Removes  the  hypothesis  of  an  implication  in  the  antecedent  of  a  sequent  or  the  first  con¬ 
junct  in  a  conjunction  in  the  consequent  of  the  sequent  if  the  hypothesis  or  first  conjunct  can  be 
trivially  deduced  from  the  sequent. 

Use:  This  strategy  was  developed  to  compensate  for  the  fact  that  the  PVS  rule  ASSERT  performs 
the  desired  operation  only  if  the  hypothesis  or  conjunct  to  be  cancelled  is  a  simple  formula  (e.g.,  not 
quantified,  not  a  conjunct  or  disjunct,  etc.).  It  does  not  correspond  to  any  substantive  step  used  in 
high  level  hand  proofs.  It  is  helpful  for  cleaning  up  the  sequent  visually  and,  in  some  cases,  as  a 
preparatory  step  to  certain  TAME  strategies  that  employ  forward  chaining. 

(COMPUTE_POSTSTATE  [<label>]) 

Effect:  Causes  the  definition  of  the  variable  “poststate”  that  is  saved  among  the  hidden  formulas 
(by  AUTO_INDUCT)  to  be  substituted  for  “poststate”  (only  in  formulas  labeled  <label>,  if  the 
argument  <label>  is  present),  and  performs  some  computation  on  the  resulting  expression  by  apply¬ 
ing  the  definition  of  the  transition  function  and  a  certain  amount  of  simplification. 

Use:  This  strategy  is  useful,  for  example,  when  (using  SUPPOSE)  a  case  split  based  on  some  pro¬ 
perty  of  the  poststate  has  occurred  in  an  induction  branch  of  an  induction  proof. 

(CONST_FACTS) 

Effect:  Introduces  as  separate  formulas  the  facts  about  the  constants  used  in  a  specification  that  are 
formalized  in  the  axiom  const_f  acts,  a  standard  template  entry  (whose  default  is  true). 

Use:  Needed  when  the  correctness  of  a  lemma  or  proof  branch  depends  on  the  known  facts  about 
the  constants.  These  facts  are  typically  in  the  form  of  inequalities  or  other  relations  between  the 
constants. 

(DIRECT_PROOF) 

Effect:  Performs  the  standard  set  of  initial  steps  in  the  direct  proof  of  a  formula  of  the  form 
(* )  (FORALL (s  .states ):reachable  {s)  =>  Inv_ <invname  >(s )). 

Causes  the  formula  to  be  skolemized  and  separated  into  parts  labeled  “prestate-reachable”  and 
“conclusion”.  When  Inv_<invname>  expands  to  a  quantified  formula,  automatically  skolemizes 
the  conclusion,  and  when  the  result  is  a  disjunction,  separates  the  disjuncts  and  gives  them  secon¬ 
dary  labels  as  “conclusion_part_l”, ... ,  “conclusion_part_n”. 

The  following  naming  conventions  are  followed;  The  state  being  reasoned  about  is  called  “pre¬ 
state”.  When  the  invariant  is  universally  quantified  over  arguments  <arg_l>,  ...  ,  <arg_n>,  the 
conclusion  is  skolemized  with  the  skolem  constants  “<arg_l>_theorem”, 

“  <arg_n  >_theorem” . 

Use:  Should  be  be  applied  only  as  the  first  step  in  the  proof  of  a  formula  of  the  form  (*).  Appropri¬ 
ate  as  the  first  step  in  the  direct  proof  of  an  invariant  lemma  as  the  consequence  of  previously 
proved  invariant  lemmas. 
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(EPSILON.WITNESS  <expr>) 

Effect:  This  strategy  instantiates  the  existence  proof  obligation  (labeled  “epsilon  axiom  existence 
proof  obligation”)  generated  by  an  application  of  the  TAME  strategy  USE_EPSILON. 

Use:  This  strategy  is  required  on  the  companion  branch  generated  by  any  application  of  the  TAME 
strategy  USE_EPSILON.  When  many  applications  of  USE_EPSILON  are  made  on  the  main  proof 
branch,  it  may  be  most  convenient  to  discharge  this  proof  obligation  using  the  command 

(BRANCH  (USE_EPSILON  <eps_pred_name>  [<eps_pred_args>]) 

((SKIP)  (EPSILON_WITNESS  <expr>))) 

(possibly  a  future  TAME  strategy)  to  avoid  confusing  multiple  use  of  the  obligation  label. 
(FOCUS_ON  <label>) 

Effect:  Repeatedly  interleaves  propositional  simplification  of  all  formulas  with  label  <label>  with 
the  application  of  flattening  and  the  PVS  decision  procedures  to  all  formulas.  Since  descendants  of 
formulas  labeled  <label>  inherit  this  label,  this  strategy  has  the  effect  of  completely  simplifying  the 
original  set  of  formulas  with  label  <label>.  It  may  result  in  multiple  proof  branches. 

Use:  Often  more  efficient  than  TRY_SIMP  (or  PVS’s  GRIND)  in  completing  the  proof  of  a  branch 
that  “is  now  obvious”.  May  be  used  when  completing  the  “obvious”  remaining  part  of  a  proof 
clearly  depends  on  the  case  breakdown  of  in  the  set  of  formulas  labeled  <label>. 

(INST_IN  <label>  <argl  >  ...  <arg/i  >) 

Effect:  Performs  (FOCUS_ON  <label>)  followed  by  instantiation,  if  possible,  of  some  formula 
labeled  <label>  with  the  values  <argl>, ... ,  <argn  >. 

Use:  This  strategy  is  intended  to  partially  make  up  for  the  fact  that  instantiation  of  internal  parts  of 
formulas  is  not  supported  in  PVS.  Although  it  sometimes  leads  to  multiple  proof  branches,  it  often 
saves  splitting  a  sequent  in  order  to  move  the  formula  to  be  instantiated  to  the  top  level. 

(NONVERBOSE) 

Effect:  Causes  APPLY_INV_LEMMA,  APPLY_LEMMA,  APPLY_SPECIFIC_PRECOND,  and 
CONST_FACTS  to  cease  printing  as  comments  the  facts  introduced  into  the  proof.  All  new  proofs 
are  then  nonverbose,  until  VERBOSE  is  invoked. 

Use:  Allows  a  more  compact  version  of  a  proof  to  be  simply  generated.  Can  make  editing  a  proof 
simpler. 

(SKOLEM_IN  <label>  <namel>  ...  <name«  >) 

Effect:  Performs  “(FOCUS_ON  <label>)”  followed  by  skolemization,  if  possible,  of  some  for¬ 
mula  labeled  <label>  with  the  skolem  constants  <namel  >, ... ,  <name«  >. 

Use:  This  strategy  is  intended  to  partially  make  up  for  the  fact  that  skolemization  of  internal  parts 
of  formulas  is  not  supported  in  PVS.  Although  it  sometimes  leads  to  multiple  proof  branches,  it 
often  saves  splitting  a  sequent  in  order  to  move  the  formula  to  be  skolemized  to  the  top  level. 

(SPECIALIZE_INDUCTION_TO  <namel>  ...  <namen  >) 

Effect:  Skolemizes  a  fonnula  labeled  “inductive-conclusion”  with  the  skolem  constants  <namel  > 
...  <namc/i  >,  and  instantiates  an  appropriate  formula  labeled  “inductive-hypothesis”  with  these 
skolem  constants.  An  alternate  version,  SPECIALIZE_INDUCTION_TO_2,  uses  SKOLEM_IN 
and  INSTJN. 
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Use:  Can  be  needed  when  a  state  formula  being  proved  as  an  invariant  has  embedded  quantifiers 
rather  than  a  universal  quantifier  at  the  top  level.  For  example; 

Inv_<invnaine\>  =  {EXISTS {x):P (x))  =>  Q 
Inv_<invname2>  =  P  =>  (FORALL{x):Q{x)) 

Can  also  be  useful  when  the  state  formula  does  have  a  universal  quantifier  at  the  top  level,  when 
there  are  embedded  quantifiers  as  well. 

(SUPPOSE  <expr>) 

Effect:  Performs  (CASE  <expr>),  and  labels  the  formula  <expr>  with  “Suppose”  on  the  main 
proof  branch  (where  it  becomes  an  hypothesis)  and  with  “Suppose  not”  on  the  companion  proof 
branch  (where  its  negation  becomes  an  hypothesis).  Inserts  comments  “Suppose  [<expr>]”  and 
“Suppose  not  [<expr>]”  in  the  saved  proof,  at  the  tops  of  the  appropriate  proof  branches. 

Use:  Exactly  the  same  as  for  CASE  (on  one  argument);  the  labels  simply  give  more  information  on 
the  role  the  formula  <expr>  is  expected  to  play  in  the  proof. 

(TRY_SIMP) 

Effect:  Performs  propositional  simplification  and  application  of  the  PVS  decision  procedures. 
Simplifies  arithmetic  operators  and  comparisons  used  with  the  type  “time”,  which,  since  it  includes 
infinity  as  a  possible  value,  is  represented  as  a  DATATYPE  in  PVS.  Applies  standard 
simplifications  associated  with  the  other  DATATYPES  in  the  specification,  through  a  combination 
of  rewrites  and  forward  chaining. 

Use:  Normally  invoked  when  the  proof  reaches  the  stage  where  a  human  would  say  “it  is  now 
obvious”.  Generally  more  efficient  for  this  purpose  than  the  PVS  strategy  GRIND.  Its  use  as  an 
intermediate  proof  step  should  be  rare.  However,  when  it  is  used  as  an  intermediate  step,  it  avoids 
destroying  as  much  of  the  high-level  representation  of  facts  and  data  as  GRIND  destroys. 

(USE_OKSTATE) 

Effect:  Expands  the  definition  of  “OKstate?”,  and  computes  the  poststate  that  appears  as  an  argu¬ 
ment  to  “OKstate?”  in  the  hypothesis  of  an  induction  proof  branch. 

Use:  Needed  in  proofs  associated  with  specifications  in  which  the  set  of  reachable  states  is  limited 
by  an  invariant  (which  is  given  the  standard  name  OKstate?  in  the  TAME  template). 

(USE_EPSILON  <pred_name>  [<pred_argl>  ...  <pred_argn  >]) 

Effect:  Finds  an  instance,  if  there  is  one,  of  a  use  of  the  predicate  P  =  <pred_name>(<pred_argl>, 
...  ,  <pred_argrt  >),  and  applies  the  epsilon  axiom  epsilon_ax  to  it.  Automatically  computes  the 
domain  type  of  P,  so  that  it  need  not  be  specified  to  apply  the  epsilon  axiom.  If  <pred_argl>  ... 
<pred_argn  >  are  not  given,  determines  them  from  the  expression  in  which  <pred_name>  is  used. 
USE_EPSILON  always  generates  a  companion  branch  requiring  an  existence  proof; 
EPSILON_'WTTNESS  can  be  used  to  discharge  the  companion  subgoal. 

Use:  Useful  when  nondeterminism  in  the  effects  of  actions  of  a  timed  automaton  is  present  and 
specified  by  means  of  the  Hilbert  e.  A  typical  example  is  a  hybrid  automaton  in  which  the  change 
in  value  of  certain  physical  quantities  due  to  time  passage  is  described  in  terms  of  constraints  rather 
than  exact  values,  and  the  new  value  of  such  a  quantity  is  expressed  as  e(P )  for  some  P .  The  argu¬ 
ments  <pred_argl>  ...  <pred_arg/i>  in  P  correspond  to  the  elap.sed  time  and  other  variables 
involved  in  the  constraints.  [Use  of  the  Hilbert  e  in  the  specification  is  safe  provided  only  state 
invariants  of  the  automaton  are  being  proved.  Because  its  value  is  deterministic  (though 
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unspecified),  it  is  not  always  safe  for  drawing  conclusions  about  other  specification  properties  (such 
as  that  a  given  sequence  of  actions  starting  from  a  given  state  always  results  in  the  same  new  state).] 

(VERBOSE) 

Effect:  Causes  APPLYJNV^LEMMA,  APPLY^LEMMA,  APPLY„SPECIFIC_PRECOND,  and 
CONST_FACTS  to  resume  printing  as  comments  the  facts  introduced  into  the  proof.  All  new 
proofs  are  then  verbose,  until  NONVERBOSE  is  invoked. 

Use:  Causes  most  of  the  relevant  information  introduced  in  the  course  of  a  proof  to  be  included  in 
the  proof  script  as  comments. 
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Appendix  1  :  The  TAME  Timed  Automaton  Template. 

Below  is  the  template  for  a  timed  automaton  specification  in  TAME.  Arbitrary  declarations  permis¬ 
sible  in  a  PVS  theory  may  be  added  if  desired,  including  declarations  of  constants,  types,  or  axioms.  The 
parts  that  must  be  filled  in  are  labeled  for  n  =0,...,7,  and  represent  the  following  information: 

<..0..>  :  any  relationships  among  the  constants  in  the  specification — the  default  is  true; 

<..1..>  :  declarations  of  the  non-time-passage  actions  of  the  automaton; 

<..2..>  :  the  type  of  the  basic  state  (i.e.,  the  non-time-related  part  of  the  state)  of  the  automaton,  which  is 
usually  a  record  type  whose  fields  represent  the  state  variables; 

<..3..>  :  an  arbitrary  state  predicate  that  can  be  used  to  restrict  the  state  space — its  default  is  true; 

<..4..>  :  the  preconditions  for  the  non-time-passage  actions; 

:  the  effects,  if  any,  of  time  passage  on  the  basic  state  variables; 

<..6..>  :  the  effects  of  the  non-time-passage  actions  on  state  variables  other  than  now ; 

<.,7..>  :  the  remaining  part  of  the  initial  condition  on  the  state — actually,  the  form  of  the  start  state 
predicate  start  is  flexible,  but  start(5 )  must  imply  now  (s)  =  zero . 


<timed-automaton  name>:  THEORY 
BEGIN 

IMPORTING  time_thy 
const_facts:  AXIOM  =  <..0..>  ; 
actions  :  DATATYPE 
BEGIN 

nu(timeof:(fintime?)):  nu? 

END  actions; 

MMTstates:  TYPE  =  <..2..> 

IMPORTING  states[actions,MMTstates,time,fintime?] 

OKstate?  (s: states):  bool  =  <..3..>  ; 

enabled_general  (a:actions,  s:states):bool  =  now(s)  >=  first(s)(a)  &  now(s)  <=  last(s)(a); 
enabled_specific  (a:actions,  s:states):bool  = 

CASES  a  OF 
nu(delta_t):  (delta_t  >  zero 

&  FORALL  (aO:  actions):  NOT(nu?(aO))  =>  now(s)  +  delta_t  <=  last(aO,s)), 

<..4..> 

ENDCASES; 

trans  (a:actions,  s:states):states  = 

CASES  a  OF 

nu(delta_t):  s  WITH  [now  :=  now(s)+delta_t,  <..5..>], 

<..6..> 

ENDCASES; 

enabled  (a:actions,  s:states):bool  = 

enabled_general(a,s)  &  enabled_specific(a,s)  &  OKstate?(trans(a,s)); 
start  (s:states):bool  =  (now(s)  =  zero)  &  <..7..>  ; 

IMPORTING  machine[states,  actions,  enabled,  trans,  start] 

END  <timed-automaton  name> 
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Appendix  2  :  The  TAME  Generic  Standard  Theories. 

The  theory  machine  provides  support  for  TAME’s  induction  strategy  AUTO_INDUCT,  which 
applies  the  theorem  niachine_induct.  The  strategy  AUTO_INDUCT  also  applies  the  lemma 
reachable_trans  to  introduce  the  reachability  of  the  poststate  into  the  hypotheses  of  every 
induction  step  in  an  induction  proof.  Having  the  reachability  of  the  poststate  among  the  hypothe.ses 
facilitates  applying  a  state  invariant  lemma  to  the  poststate  in  the  proof  of  an  induction  step  when 
necessary.  The  updated  theory  machine  below  is  the  extension  of  the  theory  machine  in 
[AH_96a,AH_98]  with  reachable_trans  and  its  supporting  predicate  definition 
reachable  trans_f act. 


machine  [  states,  actions;  TYPE, 

enabled:  [actions,states  ->  bool], 
trans:  [actions,states  ->  states], 
start:  [states  ->  bool]  ]  :  THEORY 

BEGIN 

s,sl:  VAR  states 
a:  VAR  actions 
n,nl:  VAR  nat 

Inv;  VAR  pred[states];  %  pred[states]  =  [states ->  bool]; 

reachable_hidden(s,n):  RECURSIVE  bool  = 

IFn  =  0THEN  start(s) 

ELSE  (EXISTS  a,  si:  reachable_hidden(sl,n  -  1)  &  enabled(a,sl)  &  s  =  trans(a,sl)) 

ENDIF 

MEASURE  n 

reachable(s):  bool  =  (EXISTS  n:  reachable_hidden(s,n)) 
base(Inv) :  bool  =  (FORALL  s:  start(s)  =>  Inv(s)) 
inductstep(Inv) :  bool  = 

(FORALL  s,  a:  reachable(s)  &  Inv(s)  &  enabled(a,s)  =>  Inv(trans(a,s))) 
inductthm(Inv):  bool  =  base(Inv)  &  inductstep(Inv)  =>  (FORALL  s:  reachable(s)  =>  Inv(s)) 
machine_induct:  THEOREM  (FORALL  Inv:  inductthm(Inv)) 

reachable_trans_fact(s,a) :  bool  =  (reachable(s)  &  enabled(a,s)  =>  reachable(trans(a,s))); 
reachable_trans:  LEMMA  (FORALL  s,a  :  reachable_trans_fact(s,a)); 

END  machine 


The  theory  states  below  is  identical  to  that  given  in  [AH_96a,AH_98]. 


states  [  tasks,  MMTstates,  time  ;  TYPE,  fin_pred  :  [time  ->  bool]  ]  :  THEORY 
BEGIN 

states:  TYPE  =  [#  basic:  MMTstates,  now:  (fin  pred),  first,  last:  [tasks  ->  time]  #] 
END  states 
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The  definitions  in  the  datatype  time  and  the  theory  time_thy  are  the  same  as  those  in 
[AH_96a,AH_98].  Several  lemmas  have  been  added  to  time_thy.  Of  these,  the  lemmas 
f  in.tinie_unique,  f  intiine_elim_l,  f  intime_eliin_2,  and  f  intiine_dur  are  used  as 
rewrite  rules  by  TAME  in  aid  of  automating  reasoning  about  inequalities  and  arithmetic  for  the  data 
type  time. 


time:  DATATYPE 
BEGIN 

fintime(dur:  { r:real|r>=0 } ) :  fintime? 
infinity:  inftime? 

END  time 

time.thy:  THEORY 
BEGIN 

IMPORTING  time 
zero:  time  =  fintime(O); 

<=  (tl,t2;time):bool  =  IF  fintime?(tl)  &  fintime?(t2)  THEN  dur(tl)  <=  dur(t2) 

ELSE  inftime?(t2)  ENDIF; 

>=  (tl,t2:time):bool  =  IF  fintime?(tl)  &  fintime?(t2)  THEN  dur(tl)  >=  dur(t2) 

ELSE  inftime?(tl)  ENDIF; 

<  (tLt2:time);bool  =  IF  fintime?(tl)  &  fintime?(t2)  THEN  dur(tl)  <  dur(t2) 

ELSE  NOT(inftime?(tl))  &  inftime?(t2)  ENDIF; 

>  (tLt2:time):bool  =  IF  fintime?(tl)  &  fintime?(t2)  THEN  dur(tl)  >  dur(t2) 

ELSE  NOT(inftime?(t2))  &  inftime?(tl)  ENDIF; 

+  (tl,t2:time):time  =  IF  fintime?(tl)  &  fintime?(t2)  THEN  fintime(dur(tl)  +  dur(t2)) 

ELSE  infinity  ENDIF; 

%  Note  that  the  definition  of is  a  problem  when  dur(tl)  <  dur(t2).  Subtraction  of 
%  time  values  in  TAME  specifications  is  therefore  strongly  discouraged.  Instead, 

%  specifications  should  be  reformulated  to  use  addition  instead. 

-  (tl  :time,  t2:(fintime?)):time  = 

IF  fintime?(tl)  &  dur(tl)  >=  dur(t2)  THEN  fintime(dur(tl)  -dur(t2)) 

ELSE  infinity  ENDIF; 

%  The  following  lemmas  are  used  by  the  automatic  strategy  TRY_SIMP  in  reasoning  about 
%  time  values. 

fintime_unique:  LEMMA  (FORALL  (zl,z2;{r;real|r>=0});(fintime(zl)  =  fintime(z2))  =>  (zl  =  z2)); 
fintime_elim_L  LEMMA  (FORALL  (z:{r:real|r>=0},  t:(fintime?));  (fintime(z)  =  t)  =>  (z  =  dur(t))); 
fintime_elim_2:  LEMMA  (FORALL  (z:{r;real|r>=0},  t:(fintime?)):  (t  =  fintime(z))  =>  (dur(t)  =  z)); 
fintime_dur:  LEMMA  (FORALL  (t:(fintime?)):  fintime(dur(t))  =  t); 
trans_order:  LEMMA  (FORALL  (tl,t2,t3:time):  tl  <=  t2  &  t2  <=  t3  =>  tl  <=  t3) 

END  time_thy _ 


9 


The  theory  real_thy  contains  various  lemmas  about  the  real  numbers  that  have  proved  useful 
when  reasoning  about  nonlinear  real  arithmetic.  These  and  additional  lemmas  arc  being  investigated 
as  a  basis  for  improved  support  for  automating  such  reasoning  as  much  as  possible.  Reasoning  about 
nonlinear  real  arithmetic  often  arises  in  the  context  of  hybrid  automata,  as  di.scussed  in  [AH_97a]. 
The  theory  reaMhy  presented  here  is  an  extension  of  that  pre.sented  in  [AH_97a]. 

real_thy:  THEORY 
BEGIN 

nonnegreal;TYPE  =  {rireal  1 0  <=  r}; 
nonposreahTYPE  =  {r.real  |  0  >=  r}; 

%  The  following  lemma  is  built  in  to  the  PVS  prelude. 

%  posreal_mult_closed:LEMMA  (FORALL  (x,y:real):  (x  >  0  &  y  >  0)  =>  x*y  >  0); 

nonnegreaLmult_closed:LEMMA  (FORALL  (x,y;real):  (x  >=  0  &  y  >=  0)  =>  x*y  >=  0); 
greater_diff_positive:LEMMA  (FORALL  (x,y;real);  (x  >  y)  =  (x  —  y  >  0)); 
greater_eq_diff_nonnegative:LEMMA  (FORALL  (x,y;real):  (x  >=  y)  =  (x  -  y  >=  0)); 
greater_posmult_closed:LEMMA  (FORALL  (x,y,z:real):  (x  >  0  &  y  >  z)  =>  x*y  >  x*z); 
greater_eq_nonnegmult_closed:LEMMA  (FORALL  (x,y,z:real):  (x  >=  0  &  y  >=  z)  =>  x*y  >=  x*z); 
twice:LEMMA  (FORALL  (x:real):  2*x  =  x  +  x); 
sq(x:real):real  =  x*x; 

diff_of_sq:LEMMA  (FORALL  (x,y:nonnegreal);  (x  >  y)  =>  (sq(x)  >  sq(y))); 
sq_nonneg:LEMMA  (FORALL  (xireal);  sq(x)  >=  0); 

nonpos_neg_quotient:LEMMA  (FORALL  (x:real,y;real);  (x  <=  0  &  y  <  0)  =>  x/y  >=  0); 
nonneg_pos_quotient:LEMMA  (FORALL  (x:real,y:real):  (x  >=  0  &  y  >  0)  =>  x/y  >=  0); 

END  real_thy  _ _ _ _ 
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Appendix  3  :  Code  for  the  TAME  Strategies. 


;  ***  Section  0  *** 

;  ***  Definitions  of  access  and  analysis  functions  for  strategies,  *** 

;  ;  The  global  variable  *timed-auto-simp-strat*  is  set  to  |  <timed-auto>_simp| 
;  ;  once  the  name  <timed-auto>  is  determined  in  either  auto_induct  or 
;;  direct_proof . 

(setq  *timed-auto-simp-strat*  ' skip) 

(setq  *timed-auto-forward-strat*  ' skip) 

(setq  * timed-auto-verbose-proof s*  t) 

(setq  *branch-counter*  0) 


(defun  has_quant  (form) 

(let  ( (has -quant  nil)) 
(mapobject  #' (lambda  (x) 


form) 

has-quant) ) 


(if 


has-quant  t 

(when  (or  (typep  x  ' f orall-expr ) 
(typep  X  ' exists-expr ) ) 
(setq  has-quant  t)  t) )  ) 


(defun  has_specif ic_precond_form  ( form) 

(let  { (has-specific  nil)) 

(mapobject  #' (lambda  (x) 

(if  has-specific  t 

(when  (and  (application?  x) 

(name?  (operator  x) ) 

(tc-eq  (id  (operator  x) ) 

'I  enabled_specif ic|  )  ) 
(setq  has-specific  t)  t) ) ) 

form) 

has-specific) ) 


(defun  has_specif ic_jprecond ( forms ) 

(eval  (cons  'or 

(loop  for  X  in  forms  collect  (has_specif ic_precond_form  x) ) ) ) ) 


(defun  is„state_var  (x) 

(cond  (x  (string-equal  (princ-to-string 

(setq  * type -comment*  (type  (typecheck 
(setq  *pc -parse-comment *  (pc-parse  x  'expr)))))) 
•' states  [actions  ,  MMTstates,  time,  f  intime?  ]")))  ) 


(defun  gather„labels  (lis  pred) 

(loop  for  X  in  lis  when  (apply  pred  (list  x) )  collect  (label  x) ) ) 
(defun  gather_negs forms  (sforms) 
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(loop  for  X  in  sforms 

when  (if  (and  (application?  (formula  x) ) 

(name?  (operator  (formula  x) ) ) ) 

(tc-eq  (id  (operator  (formula  x) ) )  'NOT) 
nil ) 

collect  x) ) 

(defun  gather_poss forms  (sforms) 

(loop  for  X  in  sforms 

when  (not  (if  (and  (application?  (formula  x) ) 

(name?  (operator  (formula  x) ) ) ) 

(tc-eq  (id  (operator  (formula  x) ) )  'NOT) 
nil)  ) 

collect  x) ) 

(defun  gather_fnums_label  (sforms  lab) 

(let  ( (negs forms  (setq  *negs forms -comment*  {gather_negs forms  sforms))) 
(possforms  (setq  *poss forms -comment*  (gather j)oss forms  sforms)))) 

(let  ( (negfnums  (setq  *negfnums- comment* 

(let  ( (fnum  0) ) 

(loop  for  X  in  negs forms  do  (setq  fnum  (-  fnum  1)) 
when  (member  lab  (label  x) )  collect  fnum)))) 

(posfnums  (setq  *pos fnums -comment * 

( let  ( ( fnum  0 ) ) 

(loop  for  x  in  possforms  do  (setq  fnum  (+  fnum  1)) 
when  (member  lab  (label  x) )  collect  fnum))))) 

(append  negfnums  posfnums) ) ) ) 

(defun  gather_forms_label  (sforms  lab) 

(loop  for  X  in  sforms  when  (member  lab  (label  x) )  collect  x) ) 

;  The  function  get_sform  gets  the  sform  in  the  list  sforms  whose  formula  number 
;  is  fnum, 

(defun  get_sform  (fnum  sforms) 

(let  ((possforms  (gather_poss forms  sforms)) 

(negs forms  (gather_negs forms  sforms) ) ) 

(cond  ( (<  fnum  0)  (nth  (-  (-  fnum)  1)  negs forms ) ) 

( (>  fnum  0)  (nth  (-  fnum  1)  possforms))))) 

;  The  function  f latten_„length  computes  the  number  of  new  formulae  that  will 
;  appear  in  the  sequent  if  "flatten"  is  applied  to  formula  whose  formula  number 
;  in  sforms  is  fnum. 

(defun  f latten_length  (fnum  sforms) 

(let  ((sform  (setq  * f orm- f 1- len-comment *  (get„sform  fnum  sforms)))) 

(cond  ( ( <  fnum  0 ) 

( f latten_length_f orm  fnum  (argument  (formula  sform)))) 

(t  ( f latten__length„f orm  fnum  (formula  sform)))))) 

;  The  function  f latten_length_f orm  computes  the  number  of  new  formulae  that 
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;  will  appear  in  the  sequent  if  “flatten"  is  applied  to  the  "apparent"  formula 
;  form  whose  formula  number  is  fnum.  Only  the  sign  of  fnum  matters. 

(defun  f latten_length_f orm  (fnum  form) 

(cond  ( (<  fnum  0) 

(cond  ( (conjunction?  form) 

(+  ( f latten_length_form  -1  (argsl  form)) 

( f latten_length_form  -1  (args2  form)))) 

((iff?  form)  2) 

(t  1))) 

(t 

(cond  ( (disjunction?  form) 

(+  ( flat ten__length_f orm  +1  (argsl  form)) 

(flatten_length_form  +1  (args2  form)))) 

( (implication?  form) 

(+  ( f latten_length_form  -1  (argsl  form)) 

( f latten_length_f orm  +1  (args2  form)))) 

(t  1))))) 

;  The  function  get_form_label  gets  the  first  sform  whose  label  is  lab. 

(defun  get_form_label  (sforms  lab) 

(let  ( (fnums-label  (gather_fnums_label  sforms  lab))) 

(cond  (fnums-label  (get_sform  (car  fnums-label)  sforms)) 

(t  nil) ) ) ) 

(defun  grab_trans  (sform) 

(let  ((trans_expr  nil) 

(expr  (formula  sform))) 

(mapobject  #' (lambda  (x)  (if  trans_expr  t 

(when  (and  (typep  x  'application) 

(tc-eq  (id  (operator  x)  )  '|  transj  )) 

(setq  trans_expr  x) 
t)  )  ) 

expr) 

trans_expr) ) 

(defun  grab_reachable_expr  (sform) 

(let  ( (reach_expr  nil) 

(expr  (formula  sform))) 

(mapobject  #' (lambda  (x)  (if  reach_expr  t 

(when  (and  (typep  x  'application) 

(tc-eq  (id  (operator  x)  )  '|  reachable]  )) 

(setq  reach_expr  x) 
t)  )  ) 

expr) 

reach_expr) ) 

(defun  grab„actions_ref  (sforms) 

(cadr  (actuals  (module-instance 

(car  (resolutions  (operator  (grab_reachable_expr  (car  sforms))))))))) 


13 


(defun  grab_adt_cons tractors  (sforms) 

(constructors  (adt  (type  (car  (resolutions  (type-value 
{grab_actions_ref  sforms) ))))))) 

(defun  grab_thy„name_base  (sforms) 

(id  (module-instance  (car  (resolutions  (type-value 
(grab_actions„ref  sforms) )))))) 

(defun  grab_inv  (sforms) 

(operator  (cadr  (exprs  (argument  (expression  (formula  (car  sforms)))))))) 
(defun  grab_inv_def  (sforms) 

(definition  (declaration  (car  (resolutions  (grab_inv  sforms)))))) 

(defun  insert_in__list  (val  lis)  (if  (member  val  lis)  lis  (cons  val  lis) ) ) 

(defun  grab_list_types  (sforms) 

(let  ((list_types  nil)) 

(mapobject 
#' (lambda  (x) 

(when  (and  (or  (typep  x  'type-name)  (typep  x  ' adt -type -name ) ) 

(eq  (id  x)  '|  list|  )  ) 

(setq  list_types 

(insert_in_list  (print-string  (car  (actuals  x) ) )  list_types) ) 

t)  ) 

sforms) 
list_types) ) 

(defun  get_ta_name  (thyname) 

(let*  ( (extnchar  (coerce  'character)) 

(endpt  (position  extnchar  thyname  : f rom-end  t) ) ) 

(subseq  thyname  0  endpt) ) ) 

(defun  simp_strat_name  (ta_name) 

(intern  (concatenate  'string  ta_name  "_simp''))) 

(defun  f orward_strat_name  (ta_name) 

(intern  (concatenate  'string  ta_name  ’'_f orward" )  )  ) 

(defun  unique_aux_name  (ta_name) 

(concatenate  'string  ta_name  ''__unique_aux" )  ) 

(defun  rewrite_thy_l_name  (ta„name) 

(concatenate  'string  ta„name  "_rewrite_aux_l " ) ) 

(defun  rewr ite_thy_2_name  (ta_name) 

(concatenate  'string  ta_name  "_rewri te_aux_2 " ) ) 

(defun  act ion_skolem_namG  (argname) 

(concatenate  'string  (string  argname)  "_action”)) 
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(defun  siinple_induct_strat_step  (inv  invform  opterm  simp_strat) 

(let*  ( (opname  (id  opterm)) 

(argnames  (mapcar  # ' id  (arguments  opterm))) 

(a.rg_skolem_names  (mapcar  # 'action_skolem_name  argnames)) 
(argsrest 

(let  ((comma-list  "")) 

(loop  for  argname  in  (cdr  arg_skolem_names )  do 
(setq  comma-list 

(concatenate  'string  comma-list 

(format  nil  "~a~a"  ”,  "  argname)))) 

comma-list ) ) ) 

'(then  , (cons  'reduce_case  (cons  inv  arg_skolem_names ) ) 

(I  match_univ_and_simp_:probe|  ,  invform  ,simp_strat) 
(set_up_:poststate) 

( comment 

, (if  (not  (string-equal  argsrest  "")) 

(format  nil  "  *'a~a~a'"a''a~a"  "Case  "  opname  "{" 

(car  arg_skolem_names )  argsrest  ")"  ) 

(if  argnames  (format  nil  "  ~a~a'“a"'a~a"  "Case  "  opname  "(" 
(car  arg_skolem_names )  ")"  ) 

(format  nil  "~a~a"  "Case  "  opname)))) 

(postpone) ) ) ) 

(defun  mk_induction_strategy  (sforms  inv) 

(let  ((thy_name  (grab_thy_name_base  sforms)) 

(opterms  (setq  * op terms -comment*  (grab__adt_cons true tors  sforms))) 
(invform  (setq  * invform- comment*  (grab_inv_def  sforms)))) 

(let  ((list_types  (setq  *list-types-comment*  (grab_list_types  sforms)))) 
(let  ( (list_rewrites_cmd  (setq  *list“rewrites-comment* 

(cons  'then 

(mapcar 

#' (lambda  (x) 

(list  ' auto-rewrite- theory 

(format  nil  "~a~a~a”  " list_rewrites [ "  x  "]"))) 
(grab_list_ types  sforms) ) ) ) ) ) 

(let  ((ta_name  (get„ta_name  (string  thy_name) ) ) ) 

(let  ( (simp„strat  (setq  *timed-auto-simp-strat * 

(simp_strat_name  ta_name) ) ) 

( f orward_strat  (setq  *timed-auto-f orward-strat* 

( forward_strat_name  ta_name) ) ) 

(unique_aux  (setq  * timed-auto-unique-aux* 

(unique_aux_name  ta_name) ) ) 

(rewrite_thy_l  (setq  * timed-auto-rewrite-thy-1* 

(rewrite_thy_l_name  ta_name) ) ) 

(rewri te_thy_2  (setq  * timed-auto-rewrite-thy-2 * 

(rewrite_thy_2_name  ta_name) ) ) ) 

(let  ( ( induction_branches  (setq  *ind-branch-comment * 

(loop  for  opterm  in  opterms  collect 
(simple_induct_strat„step  inv  invform  opterm  simp_strat ) ) ) ) ) 
'(then  (auto-rewrite  " f intime_unique"  " f intime_elim_l "  " f intime_elim_2 " 

" f intime_dur" ) 


15 


(auto-rewrite-theory  *'bool_rewrites "  ) 

,  list_rewri  tes_cnid 

(auto-rewrite- theory  , rewrite„thy_l ) 

(branch  (auto_cases  , inv) 

((then  (base_case  ,inv) 

(replace  "start-state") 

(simplify) 

( ,  simp__strat )  (prop_probe) 

(comment  "Base  case")  (postpone)) 

(branch  ( induct_cases  , inv)  , induction„branches ) ) ) ) ) 


;  Section  1 

;  ***  Strategies  that  support  induction  and  direct  proof  of  invariants, 
(defstep  auto_cases  (inv) 

(let  ((dummy  (setq  *capture-context-name*  ^current-context* ) ) ) 

(then  (lemma  "reachable_trans " ) 

(expand  "reachable_trans_fact " ) 

(lemma  "machine_induct " ) 

(expand  "inductthm") 

(inst  -1  inv) 

(split) ) ) 

"Splitting  into  machine  base  and  induction  cases") 

(defstep  base_case  (inv) 

(let  ( (s forms  (setq  *s forms -comment*  (s-forms  (current-goal  *ps*)))) 
(transexpr  (setq  *trans -comment*  (grab_trans  (cadr  sforms)))) 
(constrs  (setq  *constrs-comment* 

(constructors  (adt  (type  (car  (exprs  (argument  transexpr)))))) 
(then  (delete  2) 

(delete  -1)  ; special  for  "experimental" 

(expand  "base") 

(skolem  1  "prestate") 

(with-labels  ( f latten-dis junct  : depth  1) 

( ( "start-state"  "conclusion" ) ) ) 

( f latten_labelled_f ormula  "conclusion" ) 

(expand  "start") 

(expand  inv) ) ) 

If  II 

"Simplifying  the  machine  base  case") 

(defstep  induct_cases  (inv) 

(let  (  (x  (format  nil  "  ~a''a"'a~a~a " 

"(LAMBDA  (a:  actions):  (FORALL  (s:  states):  reachable(s)  &  " 
inv 

"(s)  &  enabled(a,s)  &  reachable ( trans (a , s ) )  =>  " 
inv 

" (trans (a, s)  )  )  )  "  )  )  ) 


)))))) 

★  ★  * 

★  ★  * 


) ) ) 


ir> 


(then 


*  (delete  2) 

(expand  ” induct step" ) 

(lemma  " actions_induction” ) 

(inst  -1  x) 

(beta) 

(branch  (split) 

((then  (skolem  1  ("s_l"  "a_l"))(inst  -1  ''a_l")(inst  -1  "s_l") 
(inst  -2  "s„l"  ”a_l")  (prop)) 

(skip) ) ) ) ) 

"Splitting  the  induction  case  on  action  class”) 

(defstep  reduce_case  (inv  &rest  vars) 

(let  ( (dummy 1  (setq  *varname- comment*  (pc-parse  "a_l"  'name))) 

(d\xmmy2  (setq  *varfind- comment* 

(find  *var name -comment*  (collect-skolem-constants ) ) ) ) 
(sforms  (setq  *s forms- comment -red*  (s-forms  (current-goal  *ps*)))) 
(dummy!  (setq  *trans -comment*  (grab_trans  (car  sforms)))) 

(cmdl  (cond  (vars  '(then  (skolem  1  ,vars)  (skolem  1  ("prestate")))) 

(t  '(skolem  1  "prestate"))))) 

(let  ( (cmd  '(then  ,cmdl 

(with-labels  (flatten) 

( ( "pre-state-reachable"  " inductive -hypo thesis " 

" full-precondition"  "post-state-reachable” 
"inductive-conclusion" ) ) ) 

, (cons  ' reduce_case_2  (cons  inv  vars))))) 

(then  (delete  -1  2) 
cmd) ) ) 

"Applying  the  standard  simplification" ) 

(defstep  reduce_case_2  (inv  &rest  vars) 

(let  ( (dummy 1  (setq  * reduce! -sforms -comment*  (s-forms  (current-goal  *ps*))))) 
( then 

(with-labels  (then  (expand  "enabled")  (flatten  "full-precondition")) 

( ("general-precondition"  "specific-precondition" 

" OKs tate? -precondition" ) ) ) 

(expand  "trans"  "inductive-conclusion"  ; assert?  NONE) 

(expand  inv  : assert?  NONE) 

(simplify) ) ) 

. . . ) 

(defstep  auto_induct  () 

(let  ((sforms  (setq  *s forms- comment*  (s-forms  (current-goal  *ps*)))) 

(inv  (setq  *inv-comment*  (string  (id  (grab_inv  sforms))))) 

(cmd  (setq  *cmd-comment*  (mk_induction_strategy  sforms  inv)))) 

cmd) 

"Taking  care  of  the  standard  steps  in  the  induction  proof") 

;  The  strategy  set_up_post state  replaces  each  "trans"  form  of  the  post-state 
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;  by  the  variable  "poststate",  which  is  defined  via  "name"  to  equal  the  "trans" 
;  form.  The  definition  of  "poststate"  is  then  hidden  under  the  label 
;  "poststate-definition",  to  be  retrieved  as  needed. 

(defstep  set_up__poststate  {) 

(let  ( (sforms  (setq  *sforms-comment-2*  (s-forms  (current-goal  *ps*)))) 

(dummy  (setq  *poststate-comments-list*  nil)) 

(post  (setq  *post-comment* 

(gather_f orms_label  sforms  '|  post-state-reachable|  ) ) ) 

(post-form-nums  (setq  *post-f orm-num-comment * 

(gather_fnums_label  sforms  '|  post-state-reachable|  ) ) ) ) 

(let  ((poststate 
(cond 
(post 

(setq  *poststate-comments-list* 

(cons  (print-string  (argument  (argument  (formula  (car  post))))) 
*poststate-comments-list* ) ) 

(setq  *poststate-comment* 

(print-string  (argument  (argument  (formula  (car  post))))))) 

(t  nil))) 

;  Note  that  post-f orm-num  is  computed  because  "replace"  refuses  to  replace  to 
;  a  label.  Hopefully  that  will  change,  since  this  computation  depends  on 
;  the  "name"  command  adding  a  new  formula  at  position  -1. 

(new-post-f orm-num  (setq  *new-post-form-num-comment * 

(cond  (post-form-nums  (-  (car  post-form-nums)  1))  (t  nil))))) 

(let  ((dummy  (setq  *hereiam*  t) ) 

(cmd  (setq  *auto-induct-2-cmd-comment * 

(cond 

(poststate  ' (then  (with-labels  (name  "poststate"  , poststate) 

( ( "poststate-definition" ) ) ) 

(replace  "poststate-definition"  , new-post-f orm-num) 
(hide  "poststate-definition" ) ) ) 

(t  ' (skip)))))) 

cmd) ) ) 

H  II 

"Taking  care  of  the  standard  steps  in  the  induction  proof") 

;  ;  The  strategy  prop_probe  is  used  to  test  whether  the  remainder  of  a  proof 
;;  is  "trivial".  It  is  part  of  several  other  "_probe"  strategies. 

(defstep  prop_probe  () 

(then*  (lift-if) 

(prop) 

(assert ) 

(fail)  ) 

. ) 

(defstep  I  match_univ_and_simpj>robG|  (invform  simp_strat) 

(let  ((dummy  (setq  *branch-counter *  (+  1  *branch-counter * ) ) ) 

(quantvars  (setq  *quantvars-commGnt * 

(if  ( f orall -expr ?  invform)  (bindings  invform)  nil)))) 
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(let  ( (skolemvars  (setq  *skolemvars -comment* 

(mapcar  #'  (lambda  (x)  (format  nil  "^a~a''  x  "_theorem'’ )  ) 
(mapcar  # ' id  quantvars ) ) ) ) ) 

(let  ( (skolemcmd  (setq  *skolemcmd-comment * 

(if  skolemvars  ' (skolem  1  , skolemvars)  '(skip)))) 

(instcmd  (setq  *instcmd-comment* 

(if  skolemvars  (cons  ' inst  (cons  -2  skolemvars))  '(skip)))) 
( s impost ratcmd  ' ( ,simp_strat) ) ) 

(then  skolemcmd  instcmd 

( f latten_labelled_formula  '|  inductive-hypothesis|  ) 

( flatten_labelled_formula  '|  indue tive-conclus ion]  ) 
simp_stratcmd  (prop_probe) ) ) ) ) 


(defstep  direct_proof  () 

(let  ( (sforms  (setq  *s forms- comment*  (s-forms  (current-goal  *ps*)))) 
(inv-name  (setq  *inv-comment*  (string  (id  (grab_inv  sforms))))) 
(thy_name  (grab_thy_name_base  sforms) ) ) 

(let  ( (ta_name  (get_ta_name  (string  thy_name) ) ) ) 

(let  ( (simp_strat  (setq  * timed-auto-simp-strat* 

(simp_strat_name  ta__name)  )  ) 

( forward_strat  (setq  *timed-auto-f orward-strat* 

( forward_strat_name  ta_name) ) ) 

(unique_aux  (setq  * timed-auto-unique-aux* 

(unique_aux__name  ta_name)  )  ) 

(rewrite_thy_l  (setq  * timed-auto-rewrite- thy- 1* 

(rewrite_thy_l__name  ta_name)  )  ) 

(rewrite_thy_2  (setq  *timed-auto-rewrite- thy-2 * 

(rewrite_thy_2__name  ta_name)  )  )  ) 

(then  (skolem  1  "prestate") 

(expand  inv-name) 

(with-labels  ( f latten-dis junct  : depth  1) 

( ( "prestate-reachable"  "conclusion" ) ) ) 

( f latten_labelled_f ormula  "conclusion") 

(direct_proof_2 ) ) ) ) ) 

"Doing  the  standard  steps  of  a  non-induction  proof") 

(defstep  direct j>r oof _2  () 

(let  ((sforms  (s-forms  (current-goal  *ps*))) 

(inv  (setq  *direct-inv-commnet* 

(formula  (car  (select-seq  sforms  1))))) 

(simpemd  ' ( , * timed-auto-simp-strat* ) ) 

(skolemcmd 

(if  ( f orall-expr?  inv) 

(let  {(quantvars  (setq  * quantvars -comment*  (bindings  inv)))) 
(let  {(skolemvars  (setq  *skolemvars-comment * 

(mapcar  #' (lambda  (x)  (format  nil  "~a~a"  x  "_theorem" ) ) 
(mapcar  # ' id  quantvars ) ) ) ) ) 

' (skolem  1  , skolemvars) ) ) 

' (skip) ) ) ) 
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(then  skolemcmd  ( f latten_labelled_formula  ' |  conclusion!  )  simpcmd) ) 

"Doing  the  standard  steps  of  a  non-induction  proof") 

(defstep  direct_induction  {) 

(let  ( (sforms  (setq  *sf orms- comment *  (s-forms  (current-goal  *ps*)))) 
(inv-name  (setq  *inv-comment *  (string  (id  (grab_inv  sforms))))) 
(thy_name  (grab_thy_name„base  sforms))) 

(let  ((ta_name  (gGt_ta_name  (string  thy„name) ) ) ) 

(let  ((simp_strat  (setq  * timed-auto-simp-strat* 

(s impost rat_name  ta_name) ) ) 

( forward_strat  (setq  * timed-auto-forward-strat* 

( forward_strat_name  ta_name) ) ) 

(unigue_aux  (setq  * timed-auto-unique-aux* 

(unique_aux__name  ta_name)  )  ) 

(rewrite_thy_l  (setq  *timed-auto-rewrite-thy-l* 

(rewrite_thy_l_name  ta^name) ) ) 

(rewrite_thy_2  (setq  *timed“auto-rewrite-thy-2* 

(rewrite_thy_2_name  ta_name) ) ) ) 

(then  (skolem  1  "prestate") 

(expand  inv-name) 

(with-labels  ( f latten-dis junct  : depth  1) 

{ ( "prestate-reachable "  "conclusion" ) ) ) 

( f latten_labelled_formula  "conclusion" ) 

(direct_induction_2 ) 

)))) 

"Doing  the  standard  steps  of  a  direct-induction  proof") 

(defstep  direct_induction_2  {) 

(let  ((sforms  (s-forms  (current-goal  *ps*))) 

(inv  (setq  *dirGCt-inv-comment * 

(formula  (car  (select-seq  sforms  1))))) 

( ind-var-name  (setq  *direct-inductvar-comment* 

(id  (car  (bindings  inv))))) 

(ind-skolem-var-name  (format  nil  "~a~a"  ind-var-name  "_induct")) 
(ind- type -name  (setq  *direct-inducttype-comment * 

(let  ((induct-type  (car  (types  (car  (bindings  inv)))))) 

(cond  ((subtype?  induct-type)  (id  (print-type  indue t- type) ) ) 

( (adt-type-name?  induct-type) 

(id  (type  (car  (resolutions  induct-type))))))))) 

(ind- lemma-name  (format  nil  "““a^a"  ind-type-name  "_induction"  )  ) 

( ind-inst-cmd  (setq  *direct-instcmd-comment * 

(format  nil  " ‘'a~a~a~a'^a "  "(LAMBDA  "  (bindings  inv)  ":  " 

(expression  inv)  ")"))) 

(simpcmd  ' ( , *timed-auto~simp-strat * ) ) 

(quantvars  (setq  *quantvars-commentO *  (bindings  (expression  inv) ) ) ) 
(skolemvars  (setq  *skolemvars-commGntO * 

(mapear  #' (lambda  (x)  (format  nil  "~a~a"  x  "_theorem" ) ) 

(mapear  # ' id  quantvars)))) 

(specializeemd 
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(sGtq  *direct-specialize-comment* 

(if  ( f orall-expr?  (expression  inv) ) 

' , (cons  ' specialize_induction_to  skolemvars) 

' (skip) ) ) ) 

{ skolemcmd 

(if  ( forall-expr?  (expression  inv)) 

' (skolem  1  ,skoleravars) 

' (skip) )) 

( indue tcmd 

(if  (forall-expr?  inv) 

(let  ((inductvars  (setq  * indue tvars- comment*  (bindings  inv)))) 

(let  ((inductname  (setq  * induct name -comment* 

(id  (car  inductvars))))) 

'(then  {apply_lemma_„no_comment  ,  ind- lemma -name) 

(inst  -1  , ind-inst-cmd) 

(beta) 

(branch 

(split) 

( ,  s  impemd 

(then  (hide  "conclusion") 

(label  "induction-base-case" 

, (format  nil  "~a"  ind- lemma -name ) ) 

, skolemcmd 

( f latten_labelled„formula  "induction-base-case" ) 

, s impemd ) 

(then  (hide  "conclusion") 

(label  "induction-step-case" 

, (format  nil  "~a"  ind- lemma -name ) ) 

(skolem  "induction-step-case" 

, ind-skolem-var-name) 

(with-labels 

( f latten-dis junct  "induction-step-case"  : depth  1) 

( (" indue tive -hypo thesis "  "inductive-conclusion" ) ) ) 
, specializeemd 

( f latten_labelled_formula  " inductive-conclusion" ) 

( f latten_labelled_formula  "inductive-hypothesis" ) 
,simpcmd) ) ) ) ) ) 

' (skip) ) ) ) 

indue tcmd) 

11  n 

"Doing  the  standard  steps  of  a  direct-induction  proof") 

;  ***  Section  2  *** 

;  ***  Specialized  simplification  strategies  for  timed  automata.  *** 

;  Simplification  strategies  that  handle  time  definitions  and  other  simple 
;  types  of  reasoning  needed  for  timed  automata. 

(defstep  time_etc_simp  () 

(then*  (lift-if) 
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(assert ) 

(prop) 

(assert ) 

(expand  "  tiine_thy .  zero"  :  assert?  NONE) 

(expand  " time_thy . <= "  : assert?  NONE) 

(lift-if ) 

(expand  " time„thy . >= "  : assert?  NONE) 

(lift-if) 

(expand  "<"  :assert?  NONE) 

(lift-if) 

(expand  ">"  : assert?  NONE) 

(lift-if) 

(expand  "+"  : assert?  NONE) 

(lift-if) 

(expand  : assert?  NONE) 

(lift-if) 

(repeat*  (then*  (assert)  (split)  (lift-if)  (flatten))) 
(repeat*  (forward-chain  "  f  intiine_elim_l " )  ) 

(repeat*  (forward-chain  " f intime_elim_2 ” ) ) 

( list_f orward_chain) 

) 

"Doing  time-arithmetic") 

(defstep  list_forward_chain  {) 

(then  (then  (forward-chain  ” listf orward_6 ” )  (simplify)) 

(then  (forward-chain  " listf orward_5 " )  (simplify)) 

( forward-chain  " listf orward_7 " ) 

(then  (forward-chain  " list f orward_4 " )  (simplify)) 

( forward-chain  " listf orward_8 " ) 

( forward-chain  " listf orward_la" ) 

(forward-chain  " listf orward_l ” ) 

( forward-chain  " listf orward_2 " ) 

( forward-chain  " listf orward_3 " ) 

( forward-chain  " lis t f orward_9 " ) ) 

. ) 

(defstep  list_f orward„chain_6  () 

(branch  (then  (forward-chain  " listf orward_6 " ) (simplify)) 

( ( list_forward_chain_6 )  ( list_f orward_chain_6 )  (skip) ) ) 

. . ) 

(defstep  time_vals_simp  () 

(then*  (expand  " t ime_thy . zero" ) 

(expand  " t ime_thy . <= " ) 

(expand  " time_thy . >= " ) 

( expand  " < " ) 

(expand  ">") 

(expand  "+") 

(expand  "-") 

(lift-if) 
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) 


"Doing  time-arithmetic") 

;  The  following  shorter  version  of  time_etc_simp  was  provided  by  Shankar 
;  at  SRI.  It  is  equivalent  in  power  to  time_etc__simp,  but  testing  has  shown 
;  that  while  it  is  sometimes  equally  fast,  it  is  sometimes  several  seconds 
;  slower. 


(defstep  time_etc_simp_shankar  () 

(then  (stop-rewrite) 

(auto-rewrite-theory  " time_thy " ) 

(repeat*  (then  (lift-if ) (ground) ) ) ) 

n  » 

"Doing  time-arithmetic") 

;  try_simp_new5  is  included  for  compatiblity  with  numerous  old  proofs 
(defstep  try_simp_new5  ()  (try_simp)  ""  "") 


(defstep  try_simp  () 

(let  ((sforms  (setq  *sforms-trys imp -comment*  (s-forms  (current-goal 
{neg_quantform_list  (setq  *neg- quant form- comment* 
(gather-fnums  (s-forms  (current-goal  *ps*))  nil 
#' (lambda  (sform) 

(let  { (expr  (formula  sform))) 

{has_quant  expr) ) ) ) ) ) 

(pos_quantform__list  (setq  *pos -quant  form- comment  * 
(gather-fnums  (s-forms  (current-goal  *ps*))  '+  nil 

#' (lambda  (sform) 

(let  ((expr  (formula  sform))) 

(has_quant  expr) )))))) 


(let  ( ( label-hide-cmd 

' (then  ( label_f ormula_list 

" quantified- formula " 

, (append  neg_quant formalist  pos_quantform_list ) ) 
(hide  "quantified- formula" ) ) ) 

(rewrite-unique-cmd 
(setq  * rewrite -unique- comment* 

'(then  (auto-rewrite-theory  , *timed-auto-unique-aux* ) 
(assert) 

( stop-rewrite-theory  , * timed-auto-unique-aux* ) ) ) ) 
(rewrite-change-cmd-1 
(setq  *rewrite-change-comment* 

'(then  ( stop-rewrite-theory  , * timed-auto-rewrite-thy-1* ) 

(auto-rewrite- theory  , * timed-auto-rewrite-thy-2* ) ) ) ) 
( rewrite- change- cmd- 2 
(setq  *rewrite-stop-comment * 

'(then  ( stop-rewrite-theory  ,* timed-auto-rewrite-thy-2 * ) 
(auto-rewrite-theory  , * timed-auto-unique-aux* ) ) ) ) ) 


(then  label-hide-cmd 


*ps*) ) ) ) 
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( timG_etc_siinp) 

(reveal  "quantif ied-formula" ) 

;  NOTE:  the  following  LIFT-IF  is  included  simply  so  that  the  base  case 
;  in  lemma_3_3_3  in  fischer  can  be  handled.  If  it  is  omitted,  and 
;  time_vals_simp  is  done  first,  then  lift- if  fails  to  turn  the  CASE 
;  expression  into  an  if-then-else  expression.  Perhaps  this  is  a  result 
;  of  some  unexpected  property  of  using  EXPAND  with  : assert?  NONE  ??? 
(lift-if ) 

{ t ime„va 1 s_s imp ) 

(repeat*  (then*  (lift-if)  (split)  (flatten)  (assert))) 

;  NOTE:  the  following  takes  care  of  several  cases  where  apply-extensionality 
;  was  previously  needed. 

rewrite-change-cmd-1 

(assert) 

;  NOTE:  the  following  takes  care  of  the  cases  where  one  previously  had  to 
;  apply  a  "unique_aux"  lemma  to  the  effect  that  if  two  actions  of  the  same 
;  kind  are  equal,  then  their  parameters  are  equal, 
r ewr i t e - change -cmd- 2 
(assert ) 

;  NOTE:  it  is  unclear  why  apply-extensionality  seems  to  be  needed  in  some 
;  cases;  the  rewrites  should  handle  what  it  does  ! ! ! !  See,  in  particular, 

;  the  proof  of  lemma_5_2  in  fischer. 

( apply- ex t ens i ona 1 i ty ) 

))) 


"Applying  simple  reasoning") 


(defstep  try_simp_again  {) 

(let  ((sforms  (setq  *sforms-trys imp-comment*  (s-forms  (current-goal 
(neg_quantform_list  (setq  *neg-quant form-comment* 

(gather-f nums  (s-forms  (current-goal  *ps*))  nil 
#'(lsn±)da  (sform) 

(let  ( (expr  (formula  sform))) 

(has_quant  expr) ) ) ) ) ) 

(pos_quant formalist  (setq  *pos-quant form-comment* 
(gather-fnums  (s-forms  (current-goal  *ps*))  '+  nil 

#' (lambda  (sform) 

(let  ((expr  (formula  sform))) 

(has_quant  expr) )))))) 


(let  ( ( label-hide-cmd 

' (then  (label„formula„list 

"quanti fied- formula " 

, (append  neg„quant f orm_l ist  pos„quantform_list ) ) 
(hide  "quantif ied-formula" ) ) ) 

( rewrite- ini t -cmd 
(setq  *rewrite-ini t-comment * 

' (auto-rewrite-theory  , * t imed-auto-rewr ite- thy-1 * ) ) ) 

( rewri te-unique-cmd 
(setq  *rewr i te-uniquG-comment * 

'(then  (auto-rewrite- theory  , * timed-auto-unique-aux* ) 
(assert ) 


*ps*)))) 
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(stop-rewrite- theory  , * timed-auto-unique-aux* ) ) ) ) 

( rewrite-change -cmd-1 
(setq  * rewrite- change- comment* 

'(then  (stop-rewrite- theory  , *timed-auto-rewrite-thy”l* ) 

(auto-rewrite-theory  , * timed-auto-rewrite-thy-2 * ) ) ) ) 

( rewr ite-change-cmd-2 
(setq  *rewrite-s top-comment* 

'(then  (stop-rewrite- theory  , *timed“auto-rewrite-thy-2* ) 
(auto-rewrite-theory  , * timed-auto-unique-aux* ) ) ) ) ) 

(then  label-hide-cmd 

rewrite- ini t-cmd 
( t ime_e tc_s imp ) 

(try  (then  (repeat*  (replace*))  (assert))  (skip)  (skip)) 

(reveal  " quant if ied- formula " ) 

;  NOTE:  the  following  LIFT- IF  is  included  simply  so  that  the  base  case 
;  in  lemma_3__3__3  in  fischer  can  be  handled.  If  it  is  omitted,  and 
;  time_vals_simp  is  done  first,  then  lift-if  fails  to  turn  the  CASE 
7  expression  into  an  if-then-else  expression.  Perhaps  this  is  a  result 
;  of  some  unexpected  property  of  using  EXPAND  with  ; assert?  NONE  ??? 

(lift-if) 

;  NOTE:  iff  solves  a  problem  in  one  application  (rpc_memoryimpl )  where 
;  a  =  b  and  c  =  d  are  insufficient  for  ASSERT  to  conclude  that  a  AND  c 
;  =  b  AND  d  (all  values  being  boolean).  Thus,  it  really  is  mostly  a  band-aid. 
(iff) 

( t  ime_va  1  s__s  imp ) 

(repeat*  (then  (lift-if)  (split)  (flatten)  (assert))) 

;  NOTE:  the  following  takes  care  of  several  cases  where  apply-extensionality 
;  was  previously  needed. 

rewrite-change-cmd-1 
(assert ) 

;  NOTE:  the  following  takes  care  of  the  cases  where  one  previously  had  to 
;  apply  a  "unique_aux"  lemma  to  the  effect  that  if  two  actions  of  the  same 
;  kind  are  equal,  then  their  parameters  are  equal, 
rewr i t e - change - cmd- 2 
(assert) 

;  NOTE:  it  is  unclear  why  apply-extensionality  seems  to  be  needed  in  some 
;  cases;  the  rewrites  should  handle  what  it  does  !!!!  See,  in  particular, 

;  the  proof  of  lemma_5_2  in  fischer. 

(apply-extensionality) 

(try  (then  (repeat*  (replace*))  (assert))  (skip)  (skip)) 

))) 

"Applying  simple  reasoning") 

(defstep  timed_auto_f orward  () 

(let  ((cmd  ' ( , * timed-auto-forward-strat* ) ) ) 
cmd) 

. . ) 


(defstep  try_simp_again2  () 

(let  ( (s forms  (setq  *sforms-trys imp-comment*  (s-forms  (current-goal  *ps*)))) 
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(nGg_quant formalist  (setq  *neg-quant f orm-conunent * 

( gather- fnums  (s~forms  (current-goal  *ps*))  nil 
#Mlambda  (sform) 

(let  ( (expr  (formula  sform))) 
(has_quant  expr) ) ) ) ) ) 

(pos_quantform_list  (setq  *pos-quant form-comment* 
(gather-fnums  (s-forms  (current-goal  *ps*))  '+  nil 

#' (lambda  (sform) 

(let  {(expr  (formula  sform))) 
(has_quant  expr) )))))) 


(let  ( (label-hide-cmd 

' (then  ( label_f ormula_list 

” quantified- formula" 

,  (append  neg_quantform_list  pos__quantf orm_list )  ) 

(hide  "quantified- formula" ) ) ) 

( forward- cmd 

(setq  *simp- forward-comment*  ' ( / * timed-auto-forward-strat* ) ) ) 
(rewrite- ini t-cmd 
(setq  *rewrite-init-comment * 

' (auto-rewrite-theory  , *timed-auto-rewrite-thy-l* ) ) ) 
(rewrite-stop-cmd 
(setq  *rewrite-stop-comment* 

' (stop-rewrite-theory  , * timed-auto-rewrite- thy-1 * ) ) ) 
(rewrite-unique-cmd 
(setq  *rewrite-unique-comment* 

' (then  (auto-rewrite-theory  , * timed-auto-unique-aux* ) 

(assert ) 

(stop-rewrite-theory  , * timed-auto-unique-aux* ) ) ) ) 

( rewr ite- change -cmd- 1 
(setq  *rewrite-change-comment* 

'(then  (stop-rewrite-theory  , * timed-auto-rewrite-thy-1* ) 

(auto-rewrite-theory  , * timGd-auto-rewrite-thy-2 * ) ) ) ) 
(rewrite-change-cmd-2 
(setq  *rewrite-stop-comment* 

'{then  (stop-rewrite-theory  , * timed-auto-rewrite-thy-2 * ) 
(auto-rewrite-theory  , * timed-auto-unique-aux* ) ) ) ) ) 
(then  label-hide-cmd 

rewrite-stop-cmd 
f orward-cmd 

(try  (then  (repeat*  (replace*))  (assert))  (skip)  (skip)) 
rewrite- ini t-cmd 
( t ime_etc_s imp ) 

; rewrite-stop-cmd 
; forward- cmd 

; (try  (then  (repeat*  (replace*))  (assert))  (skip)  (skip)) 

(reveal  "quant i fied- formula " ) 

NOTE:  the  following  LIFT-IF  is  included  simply  so  that  the  base  case 
in  lemma„3__3_„3  in  fischer  can  be  handled.  If  it  is  omitted,  and 
time_vals_simp  is  done  first,  then  lift-if  fails  to  turn  the  CASE 
expression  into  an  if-then-else  expression.  Perhaps  this  is  a  result 
of  some  unexpected  property  of  using  EXPAND  with  rassert?  NONE  ??? 
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( lif t-if ) 

;  NOTE:  iff  solves  a  problem  in  one  application  ( rpc_memoryimpl )  where 
;  a  =  b  and  c  =  d  are  insufficient  for  ASSERT  to  conclude  that  a  AND  c 
;  =  b  AND  d  (all  values  being  boolean) .  Thus,  it  really  is  mostly  a  band-aid. 
(iff) 

( t  ime_va  1  s_s  imp ) 

; rewrite-init-cmd 
; (assert) 

(repeat*  (then  (lift-if)  (split)  (flatten)  (assert))) 
rewrite-stop-cmd 
f orward-cmd 

(try  (then  (repeat*  (replace*))  (assert))  (skip)  (skip)) 

;  NOTE:  the  following  takes  care  of  several  cases  where  apply-extensionality 
;  was  previously  needed. 

r ewr i t e - change - cmd- 1 
(assert) 

;  NOTE:  the  following  takes  care  of  the  cases  where  one  previously  had  to 
;  apply  a  "unique_aux"  lemma  to  the  effect  that  if  two  actions  of  the  same 
;  kind  are  equal,  then  their  parameters  are  equal. 
rewrite-change~cmd-2 
(assert) 

;  NOTE:  it  is  unclear  why  apply-extensionality  seems  to  be  needed  in  some 
;  cases;  the  rewrites  should  handle  what  it  does  !!!!  See,  in  particular, 

;  the  proof  of  lemma_5_2  in  fischer. 

( app ly- ex tens i ona 1 i ty ) 

; (try  (then  (repeat*  (replace*))  (assert))  (skip)  (skip)) 

))) 

"Applying  simple  reasoning") 

;  ***  Section  3  *** 

/ 

;  ***  Apply- lemma  strategies  for  timed  automata.  *** 

;  Some  of  the  apply-lemma  strategies  are  specialized  for  application  of 
;  state  invariant  lemmas . 

(defstep  apply„lemma  (lem  &rest  args) 

(let  ((instcmd  (cons  'inst  (cons  -1  args))) 

(cmd  (setq  * cmd- comment 2 * 

'(then  (with-labels  (lemma  , lem)  ( ( , lem) ) ) 

(apply_lemma_2  , instcmd  , lem) ) ) ) ) 

cmd) 

"Applying  a  lemma  to  some  arguments") 

(defstep  apply_lemma_2  (instcmd  lemma„name) 

(let  ( (sforms  (setq  *applylem2-sf orms-comment * 

(s-forms  (current-goal  *ps*)))) 

( lemma_f ormula_list  (setq  *  lemma- lab -comment* 

(loop  for  sform  in  sforms 
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when  (string-equal  (pr inc-to-string  (car  (label  sform) ) ) 

(princ- to-string  lemma_name ) ) 

collect  sform) ) ) 

(lemma_body  (setq  *body- comment * 

(cond  (lemma_formula_list  (formula  (car  lemma_formula_list) ) ) 
(t  nil) ) ) ) 

(lemma_comment  (setq  * comment -comment* 

(cond 

((and  lemma__body  *  timed-auto-verbose-proof  s* ) 

(format  nil  "~a~a"'a^a"  "Applying  the  lemma 
"  (princ-to-string  (argument  lemma_body) )  " 

to  the  arguments 
"  (cddr  instcmd) ) ) 

(t  •’")))) 

(cmd  (setq  *apply2-cmd- comment* 

( cond  ( lemma_body 

'(then  (comment  , lemma_comment ) 

, instcmd  ( , * timed-auto-simp-strat * ) ) ) 

( t  ' (skip) ) ) ) ) ) 


cmd) 


(defstep  apply_lemma_no_comment  (lem  &rest  args) 

(let  ((instcmd  (cons  'inst  (cons  -1  args))) 

(cmd  (setq  *cmd-comment2* 

'(then  (with-labels  (lemma  , lem)  ( ( , lem) ) ) 

, instcmd  ( , * timed-auto-simp-strat * ) ) ) ) ) 

cmd) 

"Applying  a  lemma  to  some  arguments") 

;  poststate_strategy  is  used  in  supporting  application  of  invariant  lemmas 
;  to  the  poststate  in  an  induction  proof  --  it  is  called  indirectly  by 
;  apply_inv_lemma 

(defstep  posts t a t e_s t r a t egy  (1 emma_name ) 

(let  ((sforms  (setq  *s forms- comment*  (s-forms  (current-goal  *ps*)))) 
(poststate-fnums  (setq  *poststate-s trat egy- fnums -comment* 
(gather_fnums_label  sforms  (intern  lemma_name) ) ) ) 

(cmd  (setq  *poststate-strategy-command-comment * 

'(then  (replace  "poststate-definition"  , posts tate- fnums  rl) 
(do_trans  ,lemma„name) 

(hide  "poststate-definition" ) ) ) ) ) 

cmd) 

. ) 

(defstep  apply_inv_lemma  (invno  &rest  state+quantvars ) 

(let  ((cmd  (setq  *apply- inv-lemma-cmd-comment * 

( let  ( ; (dummy 

;  (setq  * typecheck- comment *  ( typecheck 

;  (pc-parse  (car  state+quantvars)  'expr)))) 
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cmd) 


(state-arg-present  ( is_state_var  (car  s tate+quantvars ) ) ) ) 
(cond  (state-arg-present 

(let  ((state  (setq  * state -comment*  (car  state+quantvars ) ) ) 
(quantvars  (setq  *quantvars- comment* 

(cdr  state+quantvars)))) 

(setq  *state-cmd-comment* 

(cond  (quantvars 

' (apply_uni v_inv_ lemma  , invno  , quantvars  , state)) 

(t  ' (apply_simple_inv_lemma  , invno  , state) ) ) ) ) ) 

(t  (setq  *no-state-cmd-comment* 

(cond  (state+quantvars  '  (apply__univ„inv_lemma  ,  invno 

, state+quantvars ) ) 

( t  ' (apply_simple_inv_lemma  , invno) ))))))))) 


"Applying  a  state  invariant") 

(defstep  apply_simple_inv_lemma  (invno  ^optional  statevar) 

(let  {(lemma_name  (setq  * s imp le-lemmaname- comment * 

(format  nil  "'“a~a"  "lemma_"  invno))) 

( theorem_name  (setq  * simple- the or emname- comment* 

(format  nil  "~a'"a"  "theorem_"  invno))) 

(inv_name  (format  nil  "~a~a"  "Inv_"  invno)) 

(state  (cond  (statevar)  (t  "prestate")))) 

(let  ( (poststate-cmd 

(setq  *simple-poststate-cmd-comment* 

(cond  ( (string- equal  state  "poststate") 

'(then  (reveal  "poststate-definition") 

(poststate_strategy  , lemma_name) ) ) 

(t  ' (skip) ) ) ) ) ) 

(then  (try  (apply_lemma_no_comment  lemma_name  state) 

(skip) 

(apply_lemma_no_comment  theorem_name  state) ) 

(apply  (then  (split  -1  :depth  1)  (assert))) 

(expand  inv_name) 

( apply_simple_inv_lemma_2  lemma_name ) 
poststate-cmd) ) ) 

II II 

"Applying  the  appropriate  invariant  lemma") 

(defstep  apply_simple_inv_lemma_2  ( lemma__name) 

(let  ( (sforms  (setq  * s imp le-s forms -comment *  (s-forms  (current-goal  *ps*)))) 
(lemma_body  (setq  * simple -body- comment* 

(formula  (car  (loop  for  sform  in  sforms 

when  (string-equal  (princ-to-string  (car  (label  sform))) 

(princ- to~string  lemma_name) ) 

collect  sform) ) ) ) ) 

( lemma_comment  (setq  *simple-comment-comment * 

(cond 

( *  timed-auto-verbose-proof s* 

(format  nil  "~a~a"  "Applying  the  lemma 
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"  (princ-to-string  (argument  lemma_body) ) ) ) 

(t  "••)))) 

(simp_cmd  (list  * timed-auto-simp-strat* ) ) 

(cmd  (setq  *apply2-cmd“ comment*  '(then  (comment  , lemma„comment ) 

( , * timed- auto- simp- St rat * ) ) ) ) ) 

cmd) 

. ) 

(defstep  apply_univ_inv_ lemma  (invno  quantvars  &optional  statevar) 

(let  ( (lemma_name  (setq  *univ-lemmaname-comment * 

(format  nil  ''~a~a"  "lemma_"  invno))) 

( theorem_name  (setq  *univ-theoremname-comment * 

(format  nil  ""'a^a"  ”lemma_"  invno))) 

(inv_name  (format  nil  "~a~a"  "Inv_’'  invno)) 

(state  (setq  *univ-state-comment*  (cond  (statevar)  (t  "prestate" ) ) ) ) 
(inst_cmd  (cons  'inst  (cons  '-1  quantvars))) 

(dummy  (setq  *inst-comment *  (princ-to-string  inst_cmd) ) ) ) 

(let  ( (poststate-cmd 

( setq  *univ-poststate-cmd”Comment* 

(cond  ((string-equal  state  "poststate") 

'(then  (reveal  "poststate-definition") 

(posts tate_strategy  , lemma_name) ) ) 

(t  ' (skip)))))) 

(then  (try  (apply_lemma_no_comment  lemma_name  state) 

(skip) 

(apply_lemma_no„comment  theorem__name  state)) 

(apply  (then  (split  -1  :depth  1) (assert))) 

(expand  inv_name) 

(apply_univ_inv_lemma_2  lemma_name  inst_cmd) 
poststate-cmd) ) ) 

M  It 

"Applying  and  instantiating  the  appropriate  invariant  lemma") 

(defstep  apply_univ_inv_lemma__2  (lemma_name  inst_cmd) 

(let  ( (s forms  (setq  *univ-sf orms-comment*  (s-forms  (current-goal  *ps*)))) 
(lemma_body  (setq  *univ-body-comment* 

(formula  (car  (loop  for  sform  in  sforms 

when  (string-equal  (princ-to-string  (car  (label  sform) ) ) 

(princ-to-string  lemma_name) ) 

collect  sform) ) ) ) ) 

( lemma_comment  (setq  *univ- comment -comment* 

(cond 

( *  timed-auto-verbose-proofs* 

(format  nil  "~a''a"  "Applying  the  lemma 
"  (princ-to-string  (argument  lemma_body) ) ) ) 

(t  "")))) 

(simp__cmd  (list  * timed-auto-simp-strat *  )  ) 

(cmd  (setq  *apply2-cmd-comment*  '(then  (comnient  ,  lemma__comment ) 

,  inst__cmd 

( , * timed-auto-simp-strat* ) ) ) ) ) 

cmd) 
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") 


;  ***  Section  4  *** 

f 

;  ***  Other  standard  TAME  steps.  *** 

(defstep  apply_ind_hyp  {&rest  var) 

(let  ( (simplif ication_strat  * timed-auto-simp-strat* ) 

(instcmd  (setq  * app ly- ind-hyp -i ns t- comment* 

(cons  ' inst  (cons  "inductive-hypothesis"  var)))) 

(cmd  '(/ simplif ication_strat) ) ) 

(then  (reveal  "inductive-hypothesis") 
instcmd 
cmd)  ) 

II  II  ti  It  j 

;  The  strategy  apply„specif ic_precond  is  broken  into  two  parts  in  order 
;  to  permit  the  specific  precondition  to  be  expanded  and  the  resulting 
;  formula  to  be  printed  as  a  comment. 

(defstep  apply„specif ic_precond  () 

(let  ( (sforms 

(setq  *sforms-precond-comment*  (s-forms  (current-goal  *ps*))))) 

(let  ( (simp- flag  (setq  * simp -flag- comment*  (has_specif ic_precond  sforms)))) 
(then  (with-labels  (try  (expand  "enabled")  (flatten)  (skip)) 

( ("general-precondition"  "specific-precondition" 
"OKstate?“precondition" ) )  :push?  T) 

(expand  " enabled_speci f ic " ) 

(apply_specif ic__precond_2  simp- flag)  )  )  ) 

II  11  II  II  j 

(defstep  apply  specific  precond  2  (simp-flag) 

(let  ((sforms 

(setq  *s forms -precond- comment 2*  (s-forms  (current-goal  *ps*)))) 
(simplif ication_strat  * timed-auto-simp-strat* ) ) 

(let  ( (precond_sform  (get_f orm_label  sforms  '|  specif ic-precondition|  ))) 

(let  ( (precond„form  (setq  *precond- form-comment* 

(cond  (precond_sf orm  (argument  (formula  precond_sform) ) ) 

(t  nil))))) 

(let  ( (cmd  (setq  *precond-cmd-comment* 

(cond  (precond_f orm  ' (then 
(comment 

, (cond  (* timed-auto-verbose-proof s* 

(format  nil  "'"a~a"  "Applying  the  precondition 
"  (princ- to-string  precond_f orm) ) ) 

(t  "") )  ) 

( f latten_labelled_f ormula  '|  specific-preconditioni  ) 

( , simplif ication„strat ) ) ) 

(simp-flag  ' ( , simplif ication_strat) ) 

(t  ' (skip) ) ) ) ) ) 

cmd) ) ) ) 
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) 


(defstep  apply_general_prGCond  ()  (expand  "enabled_gGneral  *‘ )  . ) 

(defstep  use„OKstate  () 

(let  ((simp_cmd  (list  * timed-auto-simp-strat * ) ) ) 

(then  (expand  "OKstate? " ) 
siinp_cmd 

(do_trans  ‘’OKstate?"precondition"  )  )  ) 

"using  the  OKstate?  precondition") 

(defstep  suppose  (x)  - 

(let  ((simp_cmd  (list  *timed-auto-siinp-strat * )  ) 

(suppstring  (setq  *supp- comment* 

(format  nil  ""'a~a"  "Suppose  "  x)  )  ) 

(nsuppstring  (setq  *supp-not-comment * 

(format  nil  "~a~a'"a"  "Suppose  not  ["  x  "]")))) 

(branch  (with-labels  (casex)  (("Suppose")  (" Suppose  not ")) ) 

((then  simp__cmd  (comment  suppstring)) 

(then  simp_cmd  (comment  nsuppstring))))) 

II  II  II  II  j 

;  ;  The  strategy  const_facts  introduces  the  facts  about  the  constants  from 
;;  the  axiom  "const_facts "  in  the  template.  It  has  two  segments,  to  allow 
;  the  body  of  the  axiom  "const_facts "  to  be  expanded  and  printed  as  a  comment. 

(defstep  const_facts  () 

(then  (with-labels  (lemma  "const_facts " )  ( ( "const_f acts " ) ) ) 

(const_facts_2 ) ) 

II II 

"Adducing  facts  about  the  constants") 

(defstep  const_facts_2  () 

(let  ( (s forms 

(setq  *sforms-const-comment*  (s-forms  (current-goal  *ps*)))) 

(simplif ication_strat  *timed-auto-simp-strat * ) 

(const^form  (setq  *const- form-comment* 

(argument  (formula 

(get_f orm_label  sforms  '|  const_facts|  ) ) ) ) ) 

(cmd  (setq  * cons t-cmd- comment *  ' (then 

(comment  , (format  nil  "~a~a"  "Applying  the  facts  about  the  constants:  ^ 
"  (princ- to-string  const_form) ) ) 

( f latten_labelled_formula  '\  const„facts|  ) 

( , simplif ication_strat ) ) ) ) ) 

cmd) 

. ) 

(defstep  do_trans  (^optional  formnum) 

(let  ((cmd  (cond  (formnum 

'(then  (expand  "trans"  , formnum) 
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( , *timed”auto-simp-strat * ) 

(lift-if  , formnum) (assert) (assert) ) ) 

( t  ' ( then  ( expand  " trans " ) 

( , * timed-auto-simp-strat* ) 

(lift-if) (assert) (assert) ) ) ) ) ) 

cmd) 

II  n 

"Computing  the  transition" ) 

(defstep  compute j>oststate  {^optional  lab) 

(let  (  (sforms  (setq  *sforms-comment*  (s-forms  (current-goal  *ps*)))) 
(formnums  (setq  *compute-post-formnums -comment* 

{gather_fnums_label  sforms  (intern  lab) ) ) ) 

(cmd  (cond  (formnums 

' (then  (reveal  "poststate-definition") 

(replace  "poststate-definition"  , formnums  rl) 

(hide  "poststate-definition") 

(do„trans  , lab) ) ) 

(t  '(then  (reveal  "poststate-definition") 

(replace  "poststate-definition"  *  rl) 

(hide  "poststate-definition" ) 

(do_trans) ) ) ) ) ) 

cmd) 

"Computing  the  poststate") 

;  The  strategy  focus__on  differs  from  the  "scr"  version  in  that  the  value 
;  of  the  poststate  is  not  repeatedly  substituted.  Note  that  focus_on  does 
;  not  work  well  unless  a  label  is  passed  as  argument. 

;  (defstep  focus__on  (lab) 

;  (let  ((cmd  '(apply  (repeat* 

;  (then  (split  ,lab)  (lift-if  /lab)  ( flatten) (assert ))))) ) 

;  cmd) 

.  . .  »  j 

(defstep  focus_on  (lab) 

(let  ((cmd  '(apply  (repeat* 

(then  (split  , lab)  (lift-if  , lab) 

( f  latten__labelled_formula  ,lab)  (assert)  )  )  )  )  ) 

cmd) 

. . ) 


(defstep  inst_in  (lab  &rest  args ) 

(let  ((cmd  (setq  *ins t__in-cmd-comment*  '(then  (focus_on  ,lab) 
, (cons  'inst  (cons  lab  args)) 

( , * timed-auto-simp-strat* ) 

;(focus„on  ,lab) 

)  )  )  ) 

cmd) 

. ) 
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(defstep  skolem_in  (lab  &rest  args) 

(let  ( (cmd  (setq  *skolein_in-cmd- comment*  '(then  (focus„on  ,lab) 
(skolem  , lab  ,args) 

( , * timed-auto-simp-strat * ) 

;(focus_on  ,lab) 

)))) 

cmd) 

. ) 

(defstep  verbose  () 

(let  ({dummy  (setq  * timed-auto-verbose-proof s*  t) ) ) 

(skip) ) 

. ) 

(defstep  nonverbose  () 

(let  ((dummy  (setq  * timed-auto-verbose-proofs*  nil))) 

(skip) ) 

It  H  II  11  J 


;  ***  Section  5  *** 

/ 

;  ***  Definitions  and  strategies  to  support  reasoning  about  epsilon  *** 

(defun  attach_arg  (x  y) 

(if  (null  y) 

(format  nil  ‘'~a~a’'  x  ")") 

(if  (null  (cdr  y) ) 

(format  nil  ’’^a^a^a'^a"  x  ",  "  (car  y)  ")") 

(format  nil  "'“a'^a'^a"  x  ",  "  (attach_arg  (car  y)  (cdr  y)  )  )  )  )  ) 

(defun  make_pref_expr  (eps_pred_name  &rest  eps_pred_args ) 

(if  (null  eps_pred_args) 
eps_pred_name 

(format  nil  "~a~a~a"  eps_pred_name  "(" 

(attach_arg  (car  eps_jpred_args )  (cdr  eps_pred_args )  )  )  )  ) 

(defun  grab_epsilon_expr  (s forms  predname) 

(cond  (sforms  (cond  ( {grab_epsilon_expr_2  (car  sforms)  predname)) 

(t  (grab_epsilon_expr  (cdr  sforms)  predname)))) 

(t  nil) )  ) 

(defun  grab„epsilon_expr__2  (sform  predname) 

(let  (  {epsilon__expr  nil) 

(expr  (formula  sform))) 

(mapobject  #' (lambda  (x)  (if  epsilon_expr  t 

(when  (and  { typep  x  'application) 

(tc-eq  (id  (operator  x)  )  '|  epsilon]  ) 

(tc-eq 

(cond  ((application?  (argument  x) ) 

(id  (operator  (argument  x) ) ) ) 
( (name-expr?  (argument  x) ) 


34 


(id  (argument  x) ) ) ) 

(intern  predname) ) ) 

(setq  epsilon_expr  x) 
t)  )  ) 

expr) 

epsilon_expr ) ) 

(defstep  use_epsilon  (eps_pred_name  &rest  eps_jpred_args ) 

(let  ( (s forms  (setq  *s forms -comment*  (s-forms  (current-goal  *ps*)))) 
(€ps_expr  (setq  * epsilon -comment* 

(grab_epsilon_expr  sforms  eps_pred_name) ) ) 

(inst_pred  (setq  *pred-comment* 

(cond  ((setq  *args -comment*  eps_pred__args ) 

(setq  *args- comment 2* 

(eval  (cons  'make_pref_expr 

(cons  eps_pred_name  eps_jpred_args)  )  )  )  ) 

(t  (princ-to-string  (argument  eps_expr) ) ) ) ) ) 

( eps_const raints_comment 

(format  nil  "~a'"a'"a"  "Introducing  the  constraints  on 
epsilon ( "  inst_pred  " ) " ) ) 

( ep  s_„obl  i  ga  t  i  on_c  ommen  t 

(format  nil  "~a~a"  "Proof  that  there  is  a  value  satisfying 
"  inst__pred)  ) 

(eps_type  (setq  * type- comment*  (type  eps_expr) ) ) 

(eps_lemma  (setq  *eps lemma -comment* 

(format  nil  "~a~a'^a"  "epsilon_ax  [ "  (princ-to-string  eps_type)  "]"))) 
(eps_lemma_cmd  (setq  *eps lemma- comment 2*  '(lemma  , eps_lemma) ) ) 
(expand_cmd  (setq  * expand- comment*  '(expand  , eps_pred_name  1)))) 

(then  eps__lemma_cmd 

(inst  -1  inst_pred) 

(branch  (with- labels 
(split  -1) 

(("epsilon  axiom") 

("epsilon  axiom  existence  proof  obligation"))) 

((then  (expand  eps_pred_name  -1  1)  (flatten) 

(comment  eps_constraints_comment ) ) 

(then  expand_cmd 

(comment  eps_obl igation_c ommen t ) ) ) ) ) ) 

"Adducing  facts  about  an  epsilon  expression") 

(defstep  epsilon_witness  (witness) 

(let  ( (simplif ication_strat  * timed-auto-simp-strat * ) 

( simp-cmd  ' ( , simplif ication_strat ) ) ) 

(then  (inst  "epsilon  axiom  existence  proof  obligation"  witness) 
simp-cmd) ) 

. ) 


Section  6 

Strategies  to  compensate  for  missing  PVS  features. 
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(defstep  modus__ponens_probG  (fnum) 

(let  { (sform  (setq  *s form-comment* 

(cond  { {<  fnum  0) 

(nth  (-  (abs  fnum)  1) 

(gather_negs forms  (s-forms  (current-goal  *ps*))))) 


cmd) 


{ t 

(nth  (-  fnum  1) 

(gather_poss forms  (s-forms  (current-goal  *ps*) ))))))) 

( fnum- raw-labels  (label  sform)) 

(labels  (reverse  (mapcar  # 'princ-to-string  fnum-raw-labels ) ) ) 

(lastlabel  (setq  *lastlabel-comment* 

(cond  (labels  (car  labels))  (t  nil)))) 

(restlabels  (setq  * rest labels -comment* 

(cond  (labels  (cdr  labels))  (t  nil)))) 

(labelcmd  (setq  * label -cmd-comment* 

(cons  'then 

(loop  for  lab  in  labels  collect  '(label  , lab  "temp"  :push?  T) ) ) ) ) 
(form  (setq  *  form- comment *  (formula  sform))) 

(posform  (setq  *pos form-comment* 

(if  (negation?  form)  (argsl  form)  form))) 

(cond  (setq  *conclusion-comment* 

(if  (implication?  posform)  (args2  posform) 

(if  (conjunction?  posform)  (args2  posform)  posform)))) 

(conclstring  (princ-to-string  cond)) 

(next- fnum  (setq  *next-fnum-comment* 

(cond  ( (<  fnum  0)  (-  (+  (abs  fnum)  1)))  (t  (+  fnum  1))))) 

(casecmd  (setq  *case-cmd-comment* 

' (with-labels  (case  , conclstring)  (("temp"))))) 

(cmd  (cond  ( (<  fnum  0) 

'(try  (branch  , casecmd 
( , labelcmd 

(then  (flatten)  (assert)  (lift-if)  (prop) 

(assert)  ( fail ) ) ) ) 

(hide  ,next-fnum) 

(skip) ) ) 

(t 

'(try  (branch  , casecmd 

((then  (flatten)  (assert)  (lift-if)  (prop) 

(assert)  ( fail ) ) 

, labelcmd) ) 

(hide  ,next-fnum) 

(skip) ) ) ) ) ) 


Attempting  to  eliminate  an  hypothesis") 


(defstep  cancel_f ormulas_once  () 

(let  ( (sforms  (setq  *sforms-comment*  (s-forms  (current-goal  *ps*)))) 
( impl icat ion_l ist  (setq  *  implication-comment* 

(gather- fnums  (s-forms  ( current -goal  *ps*))  '*  nil 

#Mlambda  (sform) 
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(let  ( (expr  (formula  sform) ) ) 

(or  (and  (negation?  expr) 

(implication?  (argsl  expr) ) ) 

(and  (not  (negation?  expr) ) 

(conjunction?  expr) ))))))) 

(dummyl  (setq  *mapcar- comment* 

(mapcar  #' (lambda  (expr)  (or  (and  (negation?  expr) 

(implication?  (argsl  expr))) 
(and  (not  (negation?  expr) ) 
(conjunction?  expr) ) ) ) 

(mapcar  #' formula  (s-forms  (current-goal  *ps*)))))) 

(thenlist  (loop  for  formnum  in  implication_list  collect 

'  (modus_ponens_:probe  ,  formnum)  )  ) 

(cmd  '(apply  , (cons  'then  thenlist))) 

(dummy  (setq  *compute-comment3 *  (princ-to-string  cmd)))) 
cmd) 


(defstep  cancel_formulas  () 

(repeat*  (cancel_f ormulas_once) ) 

. . ) 


(defstep  specialize_induction_to  (&rest  vars) 

(let  ((cmd  '(then  (skolem  "inductive-conclusion"  ,vars) 

, (cons  'inst  (cons  "inductive-hypothesis"  vars))))) 

cmd) 

. . ) 


(defstep  specialize_induction_to_2  (&rest  vars) 

(let  ((cmd  '(then  (skolem_in  "inductive-conclusion"  ,vars) 

, (cons  'inst„in  (cons  " indue tive- hypothesis "  vars)) 
(prop_jprobe)  )  )  ) 

cmd) 

. ) 


;  ***  Section  7  *** 

/ 

;  ***  Miscellaneous  auxiliary  strategies.  *** 

;  f latten_labelled_formula  completely  flattens  the  formula  with  label  lab, 

;  labelling  the  resulting  parts  in  the  order  they  appear  in  the  original 
;  formula.  All  parts  also  retain  their  original  label. 

;  A  peculiarity  of  this  strategy  is  that  it  uses  a  longer  label  list  than 
;  should  be  necessary.  For  some  reason,  the  :push?  T  does  not  work  on  the 
;  last  label  in  the  list.  Therefore,  a  new  label  |  dummy]  is  appended  to  the 
;  list  of  labels. 

(defstep  f latten_labelled„f ormula  (lab) 

(let  ( (sforms 

(setq  *sforms-f latten-comment *  (s-forms  (current-goal  *ps*))))) 
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(let  {{labval  (intern  (eval  lab)))) 

(let  ((fnums 

(setq  * fnums- flat ten-comment* 

(gather_fnums_label  sforms  labval)))) 

(let  ( (cmd  (setq  * f latten-cmd-comment* 

(cons  'then 

(let  ((labcount  0)  (lablist  nil)) 

(loop  for  X  in  fnums  do 

; (setq  labcount  (+  labcount  1)) 

(setq  lablist  (setq  * f 1-lablis t-comment * 

(loop  for  y  from  1  to 

(setq  *f 1-len-comraent*  ( f latten_length  x  sforms))  collect 
(format  nil  "'“a~a~a" 

labval  "_part_'' 

(setq  labcount  (+  labcount  1)))))) 
collect  ' (with-labels  (flatten  ,x) 

(,  (append  lablist  '  (|  dummy|  )  )  ) 

:push?  T) ) ) ) ) ) ) 

cmd) ) ) ) 

. j 

;  label_formula_list  expects  a  list  fnums  of  formula  numbers,  and  a  label 
;  lab.  It  pushes  lab  as  an  extra  label  on  each  indicated  formula  in  the 
;  sequent . 

(defstep  label_formula_list  (lab  fnums) 

(let  ((labval  (eval  lab))) 

(let  ((cmd  (setq  * label -list-comment* 

(cons  'then 
(loop  for  X  in  fnums 

collect  '(label  , labval  ,x  :push?  T) ) ) ) ) ) 

cmd)  ) 

. ) 

;  The  strategy  match_condition  is  used  to  simplify  reasoning  about  an 
;  IF-THEN-ELSE  assertion.  It  can  sometimes  circumvent  splitting;  when 
;  it  does  not,  it  can  make  the  result  of  splitting  more  “natural". 

(defstep  match_condition  (fnum) 

(then  (split  fnum)  (flatten)  (assert)) 

"Attempting  to  eliminate  a  condition") 

;  The  strategy  modus^ponens  is  used  to  avoid  splitting  an  assertion  having 
;  a  complex  hypothesis  identical  to  another  assertion  present. 

(defstep  modus„ponens  (fnum) 

(branch  (split  fnum)  ((skip)  (assert))) 

"Attempting  to  eliminate  an  hypothesis") 
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;;  The  strategy  my_assert  is  used  to  capture  the  current  s-forms  at  almost 
;;  any  stage  of  a  proof  --  since  "assert"  almost  always  succeeds.  It  exists 
;  ;  for  strategy  experimentation  purposes  only. 

(defstep  my_assert  {) 

(let  ( (sforms  (setq  *sf orms- comment *  (s-forms  (current-goal  *ps*))))) 
(assert) ) 

. ) 


Section  8 


Strategies  for  the  timed_auto  version  of  opspec , 


(defstep  auto_proof_opspec_timed_auto  (inv) 

(then  (branch  (time  (auto_cases  inv)) 

((then  (base_case_timed_auto  inv) (opspec_simp_probe) (postpone) ) 
(branch  ( induct_cases  inv) 

((then  (reduce_case_timed_auto_vars_exp  inv  "t_l") 

( opspec_s imp_probe ) (postpone) ) 

(then  (reduce_case_timed_auto_vars_exp  inv  "r_l") 
(opspec_simp_probe) (postpone) ) 

(then  (reduce__case„timed_auto_vars_exp  inv  "r_l") 

( opspec_s imp_probe ) (postpone) ) 

(then  (reduce_case_timed_auto_vars_exp  inv  "r_l") 

( opspec  s imp  probe ) (postpone) ) 

(then  (reduce_case_timed_auto_no__var_exp  inv) 
(opspec_simp  probe) (postpone) ) 

(then  (reduce_case_timed_auto__no_var_exp  inv) 
(opspec_simp_probe) (postpone) ) 

(then  (reduce_case_timed_auto_no_var_exp  inv) 
(opspec_simp_probe) (postpone) ) 

(then  (reduce_case_timed_auto_no_var_exp  inv) 
(opspec_simp  j>robe)  (postpone) )))))) 

"Taking  care  of  the  standard  steps  in  the  proof") 


(defstep  base_case_timed_auto  (inv) 
(then*  (delete  2) 

(expand  "base") 

(skolem  1  "prestate") 

( flatten) 

(expand  "start") 

(flatten) 

(expand  "basic_s tart " ) 
(expand  inv) ) 


"Simplifying  the  auto  base  case") 

(defstep  reduce_case_t imed_auto_vars_exp  (inv  vars) 
(then*  (delete  2) 

(skolem  1  (vars)) 
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(skolem  1  { "prestate" ) ) 

( flatten) 

{expand  "enabled") 

( expand  " trans ” ) 

{expand  "basic__trans " ) 

{expand  inv) ) 

II  It 

"Applying  the  standard  simplification") 

{defstep  reduce_case_timed_auto_no_var_rew  {inv) 

{then*  {delete  2) 

{skolem  1  ("prestate")) 

{ flatten) 

{rewrite  "enabled" ) 

{rewrite  "trans") 

(expand  "basic_trans " ) 

(expand  inv) ) 

fi  ti 

"Applying  the  standard  simplification") 

(defstep  reduce_case_timed_auto_no_.var_exp  (inv) 

(then*  (delete  2) 

(skolem  1  ("prestate")) 

{ flatten) 

(expand  "enabled") 

{ expand  " trans " ) 

{ expand  " bas i c_t  r ans " ) 

(expand  inv) ) 

"Applying  the  standard  simplification") 

(defstep  normal ize_atexecs_timed_auto  () 

(then  (auto-rewrite-theory 

" timed_auto_thy  [  basic_states ,  actions,  nu,  nu?,  timeof, 
basic_start,  first_start,  last_start, 
basic_trans,  first_trans,  last_trans, 
enabled_specif ic ,  OKstate?]") 

(apply  (do-rewrite) ) ) 

. ) 

(defstep  do„trans_opspec_timed_auto  () 

(then  (expand  "trans") 

(expand  "basic_trans " ) (expand  " f irst_trans " ) (expand  " las t__trans " ) 
(I  opspec_simp|  )  (lift-if )  (assert)  (assert)  ) 

. ) 

;  ***  Section  9  *** 

/ 

;  ***  General  strategies  useful  in  reasoning  about  atexecs.  *** 

;  The  strategy  put_glb  finds  the  time  index  of  the  last  indexed  time  in 
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;  an  atexec  that  is  less  than  or  equal  to  the  particular  non-negative-real 
;  valued  bound  ” t imebound ” ,  and  gives  it  an  associated  name. 

(defstep  put_glb  (atexec  timebound) 

(let  (  (x  (format  nil  "'^a~a"  timebound  ”_glb")) 

(y  timebound) 

( z  atexec ) ) 

(put_glb_2  x  Y  z)) 

«i  II  II  II  j 

(defstep  put_glb_2  (boundname  timebound  atexec) 

(let  ( (x  (list  atexec  timebound)) 

(y  (list  boundname))) 

(then  (apply__lemma  "glb_fact"  x)  (skolem  -1  y)  (flatten))) 

II II  II II  j 

;  The  strategy  get_.reachables  adduces  the  fact  of  reachability  for 
;  states  in  an  atexec  near  time  index  "index",  under  various  aliases. 

(defstep  get__reachables  (atexec  index) 

(let  { (x  (list  atexec  index))) 

(then  {apply_lemma  " reachable_s tates "  x)  (flatten))) 

. ) 

;  The  strategy  trans_facts  adduces  the  relatedness  of  states,  under  various 
;  aliases,  via  a  transition  in  an  atexec  near  time  index  "index". 

(defstep  trans_facts  (atexec  index) 

(let  ( (x  (list  atexec  index))) 

(then  (apply_lemma  " trans_facts "  x) 

(flatten)  (assert)  (flatten))) 

. ) 

;  The  strategy  normal ize_atexecs  converts  all  time  points  and  state  points 
;  of  an  admissible  timed  execution  to  a  normal  form,  so  that  equalities 
;  may  be  inferred . 

(defstep  normal ize_atexecs  () 

(then  (auto-rewrite- theory 

"atexecs_strat_aux [states , actions , start , now, step? , nu] " ) 
(do-rewrite) ) 

. ) 

;  The  strategy  time_order  is  used  to  infer  an  inequality  between  time 
;  indices  from  the  same  inequality  between  the  indexed  times. 

(defstep  time_order  (atexec  nl  n2 ) 

(let  ( (x  (list  atexec  nl  n2 ) ) ) 

(then  (apply_lemma  " t ime_relation"  x)  (flatten)  (simplify))) 

. ) 
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;  same_states_tcc  is  a  special  tcc  strategy  useful  in  proving  the  tecs  for 
;  the  lemmas  about  admissible  timed  traces  used  to  support  normalized_atexecs : 

(defstep  same_states_tcc  (atexec  leftend  rightend) 

(let  (  (timeseq  (format  nil  "~a~a'^a'‘  "  t  ( ”  atexec  " )  " )  ) 

(trajseq  (format  nil  ''~a'“a'“a"  ''w(''  atexec  ")"))) 

(then  (skosimp) 

(expand  "interval") 

(apply  (then  (typepred  atexec)  (hide  -1  -3  -4)  (inst-cp  -1  leftend) 
(inst  -1  rightend))) 

(apply  (then  (typepred  timeseq)  (hide  -1)  (inst  -1  leftend  rightend))) 
(apply  (then  (typepred  trajseq)  (inst  -1  leftend))) 

( expand  " 1 t ime " ) 

(assert) )  ) 


;  ***  New  strategies  inspired  by  the  Utility  Prop.  Prf. 

(defstep  name_last_event  (ename  pname  atexec  state) 

(let  (  (exists_case_body  (format  nil  "  ~a~a~a~a'“a~a~a'“a~a~a~a " 

"(exists  (n:  posnat) :  (precedes_state ( " 

atexec  " ) (n  state  ")  &  "  pname  "("  atexec  ",  " 

state  ",  n) ) ) " ) ) 

(pname_before_s_index  (format  nil  "'"a''a~a~a" 

pname  "_before_"  state  "_index")) 

(ename_index  (format  nil  "“'a^a"  ename  "_index")) 

( ename__event  (format  nil  "  *'a'"a~a~a~a"'a " 

"pi { "  atexec  " ) ( "  ename  "_index"  " ) "  ) ) ) 

(then  (branch  (case  exists_case_body) 

((then  (skolem  -1  pname_bef ore_s_index) 

(flatten  -1) 

; (apply_lemma  "last_event"  (atexec  state  pname) ) 

(branch  (apply_lemma  "last_event"  (atexec  state  pname)) 
( (then  (simplify) 

(inst  -1  pname__before_s_index) 

( modus_ponens  - 1 ) 

(hide  -2  -3) 

(skolem  -1  ename_index) 

(flatten  -1) 

(hide  -1) 

(name  ename  ename_event ) ) 

(skip) ) ) ) 

(skip) ) ) ) ) 

II  II 

"Let  '“a  be  the  last  event  with  Property  ~a  in  ~a  that  occurs  before  '~a,") 

(defstep  start__state_props_opspec  (atexec) 

(then  ( turnof f_rewr i tes  "opspec") 

(typepred  atexec) 

( turnon_rewri tes  "opspec") 

(hide  -2  -3  -4) 


42 


(expand  "start") 

(normalize  "opspec") 

(replace  -1) 

(|  opspec_simp|  ) 

(assert) ) 

"Recognizing  the  start  state  of  ~a  and  invoking  its  opspec  properties.") 


(defstep  trajectory_order  (atexec  state) 

(let  ((traj_index  (format  nil  "~a~a"  state  "_traj_index" ) ) 

(precedes_facts_l_args  (list  atexec  traj_index  state))) 
(then  (expand  "in_atexec"  -1) 

(skolem  -1  traj_index) 

(apply_lemma  "precedes_facts_l "  precedes_facts__l_args ) 

( flatten) 

(assert) ) ) 


Adducing  the  fact  that,  in  ~a,  ~a  occurs  between  the 
endpoints  of  its  trajectory,") 


;  (defstep  atexec_order  (atexec  indexl  index2 ) 


(defstep  check_enabled_specif ic„opspec  (^optional  formnum) 

(let  ( (cmd  (cond  (formnum 

'(then  (expand  "  enabled__specif  ic "  ,  formnum) 

(opspec_simp  , formnum)  (lift-if  , formnum) 
(assert) (assert) ) ) 

(t  '  (then  (expand  "enabled_specif ic " )  (i  opspec_simp|  ) 
(lift-if) (assert) (assert) ) ) ) ) ) 


cmd) 


"Expanding  and  simplifying  the  definition  of  enabled_specif ic . " ) 


(defstep  get_enabled_specif ic  (atexec  index) 

(let  ((fromindex  (format  nil  "~a~a"  index  "  -  1"))) 
(then  ( turnoff _rewrites  "opspec") 

(typepred  atexec) 

( turnon_rewrites  "opspec") 

(hide  -1  -2  -4) 

( expand  "step?" ) 

(inst  -1  fromindex) 

(simplify) 

( flatten) 

(hide  -2) 

(expand  "enabled"  -1) 

( flatten) 

(hide  -1  -3 ) ) ) 


"Retrieving  the  information  that  in  ~a,  the  ''a-th  action  is  specifically 
enabled. " ) 
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; (defstep  normalize  () 

;  (then  (auto-rewrite- theory 

;  ’'atexecs_strat_aux  [states  ,  actions  ,  start ,  now,  step? ,  nu ]" ) 

;  (apply  (do-rewrite) ) ) 

. ) 

;  A  present  from  Shankar  . 

(defun  listify  (x)  (if  (listp  x)  x  (list  x) ) ) 

(defstep  au to- rewrite-theory-with- importings 

(name  &optional  exclude-theories  importchain?  exclude  defs 
always?  tecs?) 

(let  ((name  (pc-parse  name  'modname) ) 

(theory-name  ( resolve- theory-name  name)) 

(exclude-theories  (listify  exclude-theories)) 

( exclude-theory-names 

(mapear  #' (lambda  (x)  (pc-parse  x  'modname)) 
exclude-theories) ) 

(theory  (get-theory  name) ) 

(usings  (if  importchain? 

(mapear  #' (lambda  (x) (cadr  x) ) 

(all-usings  theory) ) 

(immediate-usings  theory) ) ) 

( included-usings 

(loop  for  z  in  (cons  theory-name  usings) 

unless  (member  z  exclude-theory-names 
:  test 

# ' ( lambda  (u  v) 

(if  (actuals  v) 

(ps-eq  u  v) 

(same-id  u  v) ) ) ) 

collect  z) ) 

( theories 

(loop  for  X  in  included-usings 
collect 

(list  X  : exclude  exclude  :defs  defs 

lalways?  always?  :tccs?  tecs?)))) 
(auto-rewrite- theories$  : theories  theories)) 

"Installs  rewrites  in  theory  NAME  and  along  with  any  theories 
imported  by  NAME.  The  full  import  chain  of  theories  can  be 
installed  by  supplying  the  IMPORTCHAIN?  flag  as  T.  Theories  named 
in  EXCLUDE-THEORIES  are  ignored.  The  other  arguments  are  similar 
to  those  of  auto-rewrite- theory  and  apply  uniformly  to  each  of 
the  theories  to  be  installed." 

"Rewriting  with  ~a  and  imported  theories  therein") 

( defstep  stop-rewrite -theory- with- importings 
(name  ^optional  exclude-theories  importchain?) 

(let  ({name  (pc-parse  name  'modname)) 

(theory-name  ( resol ve- theory-name  name)) 
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(exclude-theories  (listify  exclude-theories ) ) 

(exclude- theory-names 

(mapcar  #' (lambda  (x)  (pc-parse  x  'modname) ) 
exclude-theories) ) 

(theory  (get- theory  name) ) 

(usings  (if  importchain? 

(mapcar  #' (lambda  (x) (cadr  x) ) 

(all-usings  theory) ) 

(immediate-usings  theory) ) ) 

( included-usings 

(loop  for  z  in  (cons  theory-name  usings) 

unless  (member  z  exclude- theory-names 
:  test 

# ' (lambda  (u  v) 

(if  (actuals  v) 

(ps-eq  u  v) 

(same- id  u  v) ) ) ) 

collect  z) ) 

(theories  included-usings) ) 

(stop-rewrite-theory$  : theories  theories) ) 

"Un-Installs  rewrites  in  theory  NAME  and  along  with  any  theories 
imported  by  NAME.  The  full  import  chain  of  theories  can  be 
un- installed  by  supplying  the  IMPORTCHAIN?  flag  as  T.  Theories  named 
in  EXCLUDE-THEORIES  are  ignored.  The  other  arguments  are  similar 
to  those  of  auto-rewrite- theory  and  apply  uniformly  to  each  of 
the  theories  to  be  installed. " 

"Stopping  Rewriting  with  ~a  and  imported  theories  therein") 

;  End  present  from  Shankar  . 

(defstep  turnon_rewrites  (thy_name) 

(let  ((strat_thy  (format  nil  "'^a"'a"  thy_name  "__strat__aux"  )  ) 

(non_strat_thy  (format  nil  "~a~a"  thy_name  "_atexecs_aux" ) ) ) 
(then  (auto-rewrite- theory-with-importings 

strat_thy  : exclude-theories  non_strat_thy) ) ) 

"Turning  on  the  atexecs  rewrites  associated  with  ~a . " ) 

(defstep  turnof f_rewrites  (thy__name) 

(let  (  (strat_thy  (format  nil  "~a'"a"  thy_name  "_strat_aux" )  ) 

(non__strat_thy  (format  nil  "~a'“a"  thy_name  "_atexecs_aux"  )  )  ) 
(then  (stop- rewrite- theory-with-importings 

strat_thy  : exclude-theories  non_strat„thy) ) ) 

"Turning  off  the  atexecs  rewrites  associated  with  “a.") 

(defstep  normalize  (thy__name) 

(let  ( (strat_thy  (format  nil  "~a~a"  thy_name  "_strat_aux" ) ) 

(non_strat_thy  (format  nil  "~a^a"  thy„name  "„atexecs_aux" ) ) ) 
( then  (auto-rewrite-theory-with- importings 

strat_thy  :  exclude-theories  non__strat_thy ) 
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(apply  (do-rewrite) ) ) ) 


"Normalizing  the  representation  of  times  and  states  for  ~a .  "  ) 

(defstep  expand_state„preds  (&optional  formnum) 

(let  ( (cmd  (cond  (formnum  '(then  (expand  "predIMPLIES"  , formnum) 

(expand  "predAND"  , formnum) 

(expand  "predNOT"  , formnum) 

(expand  " f state_precedes "  , formnum) 
(expand  "precedes_state"  , formnum) 
(expand  "gate_status__up"  ,  formnum)  )  ) 
(t  '(then  (expand  "predIMPLIES") 

(expand  "predAND") 

(expand  "predNOT") 

(expand  " f state_precedes " ) 

(expand  "precedes_state" ) 

(expand  " gate_status_up" )))))) 

cmd) 

II 11 

"Expanding  the  definitions  of  the  standard  state  predicates  and 
state  predicate  combinators . " ) 


;  ***  Section  10 

/ 

;  ***  Grabbing  the  application-specific  strategies, 

(load  "local-strategies") 
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Appendix  4  :  Example  Template  Instantiation,  Local  Theories,  and  Local  Strategies. 

The  first  section  of  this  Appendix  contains,  as  an  example  template  instantiation,  the  definition 
of  the  Steam  Boiler  Controller  studied  in  [AH_97a].  This  definition  has  gone  through  several  phases. 
The  first  phase  was  an  encoding  of  the  specification  in  [LL_96a].  The  second  phase  incorporated 
modifications  that  were  conjectured  as  reasonable  corrections  once  (an  older  version  oO  TAME  had 
uncovered  some  typos  and  inconsistencies  in  the  original  specification.  The  third  and  final  phase 
incorporates  the  corrections  provided  by  the  authors  of  [LL_96a]  in  [LL_96b].  Relics  of  the  first  two 
phases  are  commented  out  using  %%. 

The  remaining  two  sections  contain  the  local  theories  and  strategies  for  the  steam  boiler  con¬ 
troller  application  needed  to  support  the  strategies  in  the  current  version  of  TAME.  Although  many 
of  the  lemmas  in  the  theories  in  the  second  section  have  “rewrite”  in  their  name  and  are  currently 
being  used  as  rewrites,  it  is  planned  that  ultimately  their  main  use  will  be  in  forward  chaining.  Since 
PVS  has  an  AUTO-REWRITE-THEORY  command  but  not  an  AUTO-FORWARD-CHAIN- 
THEORY  command,  one  or  more  additions  to  the  local  strategies  file  will  be  required  to  accomplish 
this  forward  chaining.  A  future  version  of  TAME  will  generate  the  local  theories  and  strategies  from 
the  timed  automaton  template  instantiation;  at  present,  this  must  be  tediously  done  by  hand. 

Appendix  4.1 :  Instantiating  the  Template  for  a  Boiler  Control  System. 

boilersys_decls :  THEORY 
BEGIN 

timed__auto_lib :  LIBRARY  =  "  .  . /timed_auto_lib"  ; 

IMPORTING  tiined_auto_lib@time_thy 
IMPORTING  timed_auto_lib@real_thy 

I:  posreal; 

S:  posreal; 

U_1 ,  U_2 :  posreal ; 

M_1 ,  M_2 :  posreal ; 

W:  posreal; 

P:  posreal; 
num^pumps :  posnat ; 

C:  posreal; 

delta_LOW{sr„old:nonnegreal,sr_new:nonnegreal, t: (fintime?) ) rnonnegreal; 
delta_HIGH(sr_old:nonnegreal, sr_new:nonnegreal, t : (fintime?) ) monnegreal; 

num__pumps:  TYPE  =  {n:nat  |  n  <=  n\im_pumps}; 
steam_rate:  TYPE  =  {r monnegreal  |  r  <=  W} ; 

%%  water_level:  TYPE  =  {r monnegreal  [  r  <=  C} ; 
water_level:  TYPE  =  real; 

max_pumps_af  ter_set :  numjtumps  =  num_pumps  ; 
min_jpumps_af  ter_set :  num_pumps  =  0  ; 

max(xl,x2  meal)  :  real  =  IF  xl  >  x2  THEN  xl  ELSE  x2  ENDIF; 

%%  min_steam„water (sr ; steam_rate) monnegreal  =  max{0,(sr  -  U_2*I/2)*I); 
min„steam_water (sr :steam_rate) monnegreal  = 

IF  sr  <  U_2*I  THEN  sr*sr /  ( 2 *U_2 )  ELSE  sr*I  -  U__2*I*I/2  ENDIF; 

%%  min„steam_water„est  was  not  in  the  original  specification. 
min_steam_water__est  (sr:steam_rate)  monnegreal  = 
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IF  sr  <  U_1*I  THEN  sr *sr / { 2 *U_1 )  ELSE  sr*I  -  U_l*I*I/2  ENDIF; 
max_stGam_water (sr : s team_rate ) : nonnegreal  =  (sr  +  U_1*I/2)*I; 

const_facts;  AXIOM  (M_l  <  M_2  &  M_2  <=  C  &  S  <  I); 

%%  Sc  M_1  +  U_l*I*I/2  <  M_2  -  P*  ( I-S )  *num_pumps 

%%  Sc  U_1*I  <  W)  ; 

%%  Lemmas  lGirima_l_l  through  lemma„l  are  facts  that  can  be  proved  about 
%%  delta_LOW  and  delta_HIGH  from  appropriate  definitions  of  these  functions, 
%%  using  various  facts  from  the  Calculus.  Here,  they  are  simply  made  axioms. 

lemma_l_l :  AXIOM  (FORALL  {a, b : nonnegreal ,  u :( f intime? )) ; 
delta_LOW(a,b,u)  <=  delta_HIGH(a,b,u)); 

lemma_l_2 :  AXIOM  (FORALL  (a , b : nonnegreal ,  u :{ f intime? )) : 

%%  delta_LOW{a,b,u)  >=  max(a*dur(u)  -  U_2 *dur (u) *dur (u) /2 ,  a*a/{2*U_2))  & 

%%  max(a*dur(u)  -  U_2*dur (u) *dur (u) /2 ,  a*a/(2*U_2))  >=  0); 
delta_LOW(a,b,u)  >=  IF  a  <  U_2*dur(u)  THEN  a*a/(2*U_2) 

ELSE  a*dur(u)  -  U_2*dur (u) *dur (u) /2  ENDIF); 

lemma_l„3 :  AXIOM  (FORALL  (a , b : nonnegreal ,  u :( f intime? )) : 

%%  delta_LOW(a,b,u)  >=  max(b*dur(u)  -  U„1 *dur (u) *dur (u) /2  ,  0)); 
delta_LOW (a, b, u)  >=  IF  b  <  U„l*dur(u)  THEN  b*b/(2*U_l) 

ELSE  b*dur(u)  ~  U_l*dur (u) *dur (u) /2  ENDIF); 

lemma_l_4 :  AXIOM  (FORALL  (a, b, c : nonnegreal ,  t , u :( f intime? )) : 
delta_LOW(a,b,u)  +  delta_LOW (b, c , t )  >=  delta_LOW (a , c , t+u) ) ; 

lemma_l„5 :  AXIOM  (FORALL  (a , b : nonnegreal ,  u : ( f intime? ) ) : 

(a  +  b)*dur(u)/2  >=  delta_LOW (a , b, u) ) ; 

lemma_l_6 :  AXIOM  (FORALL  (a , b : nonnegreal ,  u :( f intime? )) : 
delta_HIGH(a,b,u)  <=  (b*dur(u)  +  U_2 *dur (u) *dur (u) /2 ) ) ; 

%  The  following  lemma  is  commented  out  because  it  has  the  unprovable 
%  TCC  W  <=  U_1 .  However,  it  appears  not  to  be  needed  in  any  invariant 
%  proofs. 

%  lemma_l_7:  AXIOM  delta_HIGH(W  -  U_1 , W, f intime ( I ) )  =  W*I  -  U_l*I*I/2; 

lemma_l__8  :  AXIOM  (FORALL  (a ,  b,  c  : nonnegreal ,  t ,  u  :(  f  intime?  ))  : 
delta_HIGH (a, b,u)  +  delta_HIGH (b, c , t )  <=  delta_HIGH(a,c,u+t)); 

lemma_l_9:  AXIOM  (FORALL  (a , b ; nonnegreal ,  u :( f intime? )) : 
delta_HIGH(a,b,u)  >=  (a  +  b) *dur (u) /2 ) ; 

lemma_l_10 :  AXIOM  (FORALL  (a , b : nonnegreal ,  u :( f intime? )) : 
delta_HIGH(a,b,u)  <=  (a*dur{u)  +  U_l*dur (u) *dur (u) /2 ) ) ; 

bool_pred (b : boolean) : boolean  =  true; 

%%  num_pumps_pred (n_max :num_pumps ) (n : {n : num_pumps  |  n  <=  n_max}):bool  =  true; 
num_pumps_pred (n_max : num_pumps ) (n : num__pumps ) :bool  =  n  <=  n„max; 

water_level„init_pred (q : water_level ) : bool  =  (M„l  <  q  &  q  <  M_2 ) ; 

%%  water_level_init_pred (q : water_level ) : bool  = 

%%  %  old  version  before  correction  ->  (M_l  <  q  &  q  <  M__2 )  ; 

%%  (M„l  +  U_.l*I*I/2  <  q  &  q  <  M_2  -  P*(I-S)*num_pumps); 

steam_rate__pred  (v_old :  nonnegreal ,  delta_t :  (f  intime?)  ) 

(v_new : nonnegreal ): bool  = 

v_old  -  U__2*dur  (delta_t)  <=  v_„new  &  v_new  <=  v_old  +  U„1  *dur  (delta^t )  ; 
water_level_pred (q_old : water_level , pr : num_pumps , v_old, v_new : nonnegreal , 
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delta„t:  (f intime?)  )  (q__new: water_levGl )  :bool  = 
q_old  +  pr*P*dur (delta_t )  -  delta„HIGH (v_old, v_new, del ta_t ) 

<=  q_new 
&  q_new 

<=  q„old  +  pr*P*dur (delta_t )  -  del ta_LOW (v_old, v_new, delta„t ) ; 

delta„t:  VAR  (fintime?); 
e_stop:  VAR  boolean; 
ps e t , w , p :  VAR  num_pumps ; 
s:  VAR  nonnegreal; 

actions  :  DATATYPE 
BEGIN 

nuCtimeof : (fintime?) ) :  nu? 

actuator  (e_stop_of  : boolean,  pset_of  :nTim_pumps)  :  actuator? 
sensor (s_of : steam_rate,  w_of : water_level ,  p__of :num_pumps ) :  sensor 
controller:  controller? 
activate:  activate? 

END  actions; 
a:  VAR  actions; 

MMTstates:  TYPE  =  [#  do_output_part :  boolean, 

stopmode_part :  boolean, 
wl_part:  water_level, 
sr_part:  steam__rate, 
pumps_part :  num_pumps , 
px_part :  num_pumps , 

%  boiler  below  -  controller  above  % 

pr_part :  num__pumps , 
q  part:  water_level, 
v_jpar t :  nonnegreal , 
pr_new_j5art :  num__pumps , 

%%  error_part:  {n:num_pumps  |  n  <=  pr_new_part} , 

error_part:  num_pumps, 
do_sensor_part :  boolean, 
set_part:  nonnegreal, 
read_part :  nonnegreal , 
stop_part:  boolean  #]; 

IMPORTING  timed_auto_lib@states [actions , MMTstates , time, fintime?] 

%  Definitions  providing  simple  access  to  state  variables, 

do_output (s : states) :boolean  =  do_output_part(basic(s)); 
stopmode (s : states) : boolean  =  stopmode_part(basic(s)); 
wl (s : states ) :water_level  =  wl„part(basic(s)); 
sr  (s  :  states ):  steam_rate  =  sr__part{basic(s)); 
pumps (s : states ) :num_pumps  =  pumps_part{basic{s)); 
px (s : states ): num_pumps  =  px_part(basic(s)); 
pr  ( s  :  states ):  num_pumps  =  pr_jpart(basic{s)); 
q ( s : states ): water_level  =  q  part (basic ( s )) ; 


v(s : states) inonnegreal  =  v_part{basic(s)); 
pr_nGw{s  :  states)  :nuin_pumps  =  pr_new_part  (basic  (s)  )  ; 

%%  error (s : states ): {n : numj>umps  |  n  <=  pr_new(s)}  =  error_part{basic(s)); 
error (s estates ) :num_pumps  =  error_part(basic(s)); 

do_sensor (s : states ): bool  =  do_sensor_part(basic(s)); 
set (s : states ): nonnegreal  =  set_part{basic(s)); 
read (s : states) enonnegreal  =  read_part(basic(s)); 
stop (s : states) :bool  =  stop_part (basic (s )) ; 

OKstate? (s : states ): bool  =  true; 

enabled_general  (aeactions,  s : states ): bool  = 

now(s)  >=  first(s)(a)  &  now(s)  <=  last(s){a); 

enabled_specif ic  (aiactions,  s : states ): bool  = 

CASES  a  OF 

nu{delta_t) ;  {delta_t  >  zero 
Sc  stop(s)  =  false 

Sc  now(s)  +  delta_t  <=  f  intime  ( read  (s )  ) 

Sc  now(s)  +  delta_t  <=  f  intime  (set  ( s )))  , 
actuator (e_s top, pset) :  (do_output (s )  =  true 

Sc  pset  =  px(s) 

Sc  e_stop  =  stopmode  (s ))  , 
sensor (steam, w, p) :  (now{s)  =  f intime (read (s ) ) 

Sc  do_sensor(s)  =  true 
Sc  stop(s)  =  false 
Sc  VI  =  q  (s ) 

Sc  steam  =  v(s) 

Sc  p  =  pr  (s)  )  , 

activate:  (now(s)  =  f intime (set (s) )  &  stop(s)  =  false), 
controller:  true 
ENDCASES; 

trans  (a:actions,  s : states ): states  = 

CASES  a  OF 

nu(delta_t):  LET  new_v_part  =  epsilon (steam_rate_pred (v (s ), delta_t )) , 
new  q  part  =  epsilon (water_level_pred (q ( s ), pr ( s ) , 

V ( s ) , new_v_part , delta_t ) )  IN 
s  WITH  (now  :=  now(s)  +  delta__t, 
basic  :=  basic (s)  WITH 

[v_part  :=  new_v_part,  q  part  :=  new  q  part] ] , 
actuator  (e__stop ,  pset )  :  s  WITH  [basic  :=  basic(s)  WITH 

[pr_new_part  :=  pset, 
stop_part  :=  e_stop, 
do_sensor_part  :=  true, 
do_output„part  :=  false, 
rGad_part  :=  dur(now(s))  +  I]], 

sensor ( steam, w, p ) :  s  WITH 
[basic  :  basic  (s)  WITH 
[sr_part  :=  steam, 
wl_part  :=  w, 
pumps__part  :=  p. 
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%% 


%% 


do_sensor_part  :=  false, 
do_output_part  :=  true, 
stopmode_part  := 

IF  safety_checks  THEN  true  ELSE  epsilon (bool_pred)  ENDIF 
WHERE  safety_checks  = 
steam  <=  W  -  U_1*I  OR 
steam  >=  W  -  U_1*I  OR 

w  >=  M_2  -  P* {p*S  +  max_pumps_af ter_set* ( I  -  S)) 

+  min_steam_water  (steam)  OR 
w  <=  M_1  -  P* (p*S  +  min_pumps_af ter_set* ( I  -  S) ) 

+  max_steam_water  (steam)  ]], 

activate:  LET  new„error_j)art  =  epsilon  (num_jpumps_pred (pr_new (s ))  )  IN 
s  WITH  [basic  :=  basic (s)  WITH 
[set__part  :=  read(s)  +  S, 
error_part  : =  new_error_par t , 
pr_part  :=  pr__new(s)  -  error_part]  ]  , 
pr_jpart  :=  pr__new(s)  -  new_error_part]  ]  , 
controller:  s  WITH  [basic  :=  basic (s)  WITH 

[pxjart  :  =  epsilon  (num_pumpsj)red  (num_pumps )  )  ]  ] 


ENDCASES 


enabled  (a:actions,  s : states ): bool  = 

enabled_general (a, s)  &  enabled_specif ic (a, s)  &  OKs tate? ( trans (a , s ) ) ; 

start  (s : states ) :bool  = 

s  =  LET  init_water_„level  =  epsilon (water_level_init_pred)  IN 
(#  basic  :=  (#  do_output_part  :=  false, 

%%  s topmode_part  :=  false, 

stopmode_part  :=  true, 
wl_part  :=  init_water_level , 
sr_part  :=  0, 
pumps  part  : =  0 , 
px_part  :=  0, 

%  boiler  part  below  -  controller  part  above  % 

:=  0, 

q  part  :=  init__water_level , 
v_part  :=  0, 
pr  new  part  : =  0 , 
error_part  :=  0, 
do_sensor_part  :=  true, 
set_part  :=  S, 
read_:part  :  =  0 , 
stop_part  :=  false  #), 


now  :=  zero, 

first  :=  (LAMBDA  a:  zero), 
last  :=  (LAMBDA  a:  infinity)  #) 

IMPORTING  timed_auto„lib@machine [states ,  actions,  enabled,  trans,  start] 
END  boilersys_decls 
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Appendix  4.2  :  Local  Theories  for  the  Boiler  Control  System. 

boilersys_rewri  te__aux_l :  THEORY 
BEGIN 

IMPORTING  boilersys_decls 

nu_rewrite_l :  LEMMA  (FORALL  (t;  (fintime?),  a:  actions): 
nu(t)  =  a  =>  t  =  timGof(a)); 

nu_rewrite_lr :  LEMMA  (FORALL  (t:  (fintime?),  a:  actions): 
a  =  nu(t)  =>  timeof(a)  =  t) ; 

actuator_rewrite_l_l :  LEMMA  (FORALL  (e:  boolean,  p:  num„pumps,  a:  actions): 
actuator (e , p)  =  a  =>  e  =  e_stop_of (a) ; 

actuator_rewrite_l_lr :  LEMMA  (FORALL  (e:  boolean,  p:  num_puraps ,  a:  actions) 
a  =  actuator (e,p)  =>  e_stop„of(a)  =  e; 

actuator_rewrite_l_2 :  LEMMA  (FORALL  (e:  boolean,  p:  num__pumps ,  a:  actions): 
actuator (e, p)  =  a  =>  p  =  pset_of(a)); 

actuator_rewrite_l_2r :  LEMMA  (FORALL  (e:  boolean,  p:  num_jpumps,  a:  actions) 
a  =  actuator (e, p)  =>  pset_of(a)  =  p) ; 
sensor„rewrite_l„l :  LEMMA 

(FORALL  (s:  steam_rate,  w:  water_level,  p:  num_pumps ,  a:  actions): 
sensor (s , w, p)  =  a  =>  s  =  s_of(a)); 
sensor__rewrite_l_lr :  LEMMA 

(FORALL  (s:  steam_ratG,  w:  water_lGvel,  p:  num__pumps ,  a:  actions): 
a  =  sensor ( s , w, p)  =>  s_of(a)  =  s); 
sensor_rewrite_l_2 :  LEMMA 

(FORALL  (s:  steam_rate,  w:  water_level,  p:  num_pumps ,  a:  actions): 
sensor (s ,w, p)  =  a  =>  w  =  w_of(a)); 
sensor_rewrite_l_2r :  LEMMA 

(FORALL  (s:  steam_rate,  w:  water_level,  p:  num_pumps ,  a:  actions): 
a  =  sensor  (s ,  w,  p)  =>  w__of(a)  =  w)  ; 
sensor_rewrite_l_3 :  LEMMA 

(FORALL  (s:  steam_rate,  w:  water__level ,  p:  num_pumps ,  a:  actions): 
sensor  (s,w,p)  =  a  =>  p  =  p_,of(a)); 
sensor_rewr i te_l_3  r :  LEMMA 

(FORALL  (s:  steam__rate,  w:  water_lGvel,  p:  num_pumps ,  a:  actions): 
a  =  sensor (s ,w, p)  =>  p_of(a)  =  p) ; 

END  boilersys_rewrite_aux_l 

boilersys_rewrite„aux_2 :  THEORY 
BEGIN 

IMPORTING  boilersys_decls 

nu„rewr i te_2 :  LEMMA  (FORALL  (t:  (fintime?),  a:  actions): 

nu?(a)  &  t  =  timeof(a)  =>  nu{t)  =  a); 
nu_rewrite_3 :  LEMMA  (FORALL  (t:  (fintime?),  a:  actions): 
nu?{a)  =>  nu ( t imeof (a ) )  =  a) ; 

actuator_rewri te„2 :  LEMMA  (FORALL  (e:  boolean,  p:  num_pumps ,  a:  actions): 
(actuator?  (a )  &  e  =  e_stop„of{a)  &  p  =  pset_of(a))  =>  actuator  (e ,  p )  ==  a); 


actuator_rewrite_3 :  LEMMA  (FORALL  (e:  boolean,  p:  num_jpumps ,  a:  actions): 

actuator? (a)  =>  actuator (e_stop_of (a) , pset„of (a) )  =  a) ; 

sensor_rewrite_2 :  LEMMA 

(FORALL  (s:  steam_rate,  w:  water_level ,  p:  num__punips ,  a:  actions): 

(sensor?(a)  &  s=s_of(a)  &  w=w_of(a)  &  p=p_of{a))  =>  sensor ( s , w, p)  =  a); 

sensor_rewrite_3 :  LEMMA 

(FORALL  (s:  steam_rate,  w:  water_level,  p:  num_puTnps ,  a:  actions): 
sensor? (a)  =>  sensor ( s_of (a) ,  w_of(a),  p_of(a))  =  a) ; 

END  boilersYS_rewrite_aux_2 

boilersys_unique_aux :  THEORY 

BEGIN 

IMPORTING  boilersys_decls 

nu_unique:  LEMMA  (FORALL  (tl,  t2 :  ( f intime? ) ) :  (nu ( tl ) =nu ( t2 )  =>  tl  =  t2)); 

actuator_unique:  LEMMA  (FORALL  (el,e2:  boolean,  pl,p2:  num_jpumps ) : 

(actuator (el, pi)  =  actuator (e2 , p2 )  =>  el  =  e2  &  pi  =  p2)); 

sensor_unique:  LEMMA 

(FORALL  (sl,s2:  steam_rate,  wl,w2:  water_level,  pl,p2:  num_pumps) : 

(sensor  { si ,  wl ,  pi )  =  sensor  (s2  ,w2  ,p2  )  =>  sl=s2  &  wl=w2  Sc  pl=p2)); 

END  boilersys_unique_aux 

Appendix  4.3  :  Local  Strategies  for  the  Boiler  Control  System. 

(defstep  I  boiler sys_s imp]  () 

( then  ( expand  " do_output " ) 

( expand  " s  topmode " ) 

( expand  " wl " ) 

(expand  "sr") 

( expand  " pumps " ) 

( expand  " px " ) 

( expand  " max_pumps_af ter_set " ) 

(expand  "min_pumps_af ter_set " ) 

(expand  ''max_steam__water "  ) 

(expand  ”min_steam__water '* ) 

( expand  " pr " ) 

(expand  "q") 

(expand  "v") 

( expand  " pr_new " ) 

( expand  " error " ) 

( expand  " do_sensor " ) 

(expand  "set") 

(expand  "read") 

(expand  "stop") 

( flatten) ) 

ri  II 

"Expanding  some  boilersys  definitions") 
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